library(readr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(TSstudio)
library(xml2)
library(rvest)
## 
## Attaching package: 'rvest'
## The following object is masked from 'package:readr':
## 
##     guess_encoding
library(tmap)
library(stringr)
library(ggplot2)
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(tidyverse)
## ── Attaching packages ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ tibble  3.0.1     ✓ purrr   0.3.4
## ✓ tidyr   1.1.0     ✓ forcats 0.5.0
## ── Conflicts ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x plotly::filter()        masks dplyr::filter(), stats::filter()
## x rvest::guess_encoding() masks readr::guess_encoding()
## x dplyr::lag()            masks stats::lag()
## x purrr::pluck()          masks rvest::pluck()
library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
library(purrrlyr)
library(gganimate)
library(gifski)

Acceso a los datos de Open Data en La Rioja

La base del acceso se hace en https://actualidad.larioja.org/coronavirus/datos

Evolución

Evolución por días de casos confirmados (PCR), altas y fallecidos

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-452

La estructura html la sacamos copiando el html en local y abriéndolo con notepad++

<div class="col-md-6">
                        <dl>
                            <dt>Fecha de publicación:</dt>
                            <dd>28/04/2020</dd>

                            <dt>Última actualización:</dt>
                            <dd>30/04/2020</dd>

                            <dt>Ámbito temporal</dt>
                            <dd><i class="far fa-calendar-check" aria-hidden="true"></i> 24/02/2020
                                </dd>

                            <dt>Cronología</dt>
                            <dd>Fecha de creación: 28/04/2020 <br>Fecha de actualización de los datos: 30/04/2020</dd>
                        </dl>
                    </div>
page_evolucion <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-452')

# find all nodes with a class of "col_md_6"
col_md_6_evolucion <- html_nodes(page_evolucion, css = '.col-md-6')
col_md_6_evolucion
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
html_children(col_md_6_evolucion[8])
class(html_children(col_md_6_evolucion[8]))
# La fecha está en col_md_6_evolucion[8]
html_text(html_children(col_md_6_evolucion[8]))
class(html_text(html_children(col_md_6_evolucion[8])))
json_data <- jsonlite::toJSON(html_text(html_children(col_md_6_evolucion[8])))
json_data
html_children(col_md_6_evolucion[8]) %>%
  str_split("\n")
html_children(col_md_6_evolucion[8]) %>%
  str_split("\n") %>%
  class()
html_children(col_md_6_evolucion[8]) %>%
  str_split("\n") %>%
  unlist()
html_text(html_children(col_md_6_evolucion[8])) %>%
  str_split("\n")

Esto si vale

fecha_campos_evolucion <- html_children(col_md_6_evolucion[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_evolucion
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_evolucion <- html_children(col_md_6_evolucion[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_evolucion
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"
link_evolucion <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDUyfGNmPTAz'
rioja_evolucion <- read_csv(link_evolucion, locale = locale(date_names = "es"),
                            skip = 1, 
                            col_names = c('fecha', 'confirmados_PCR', 'altas', 'fallecidos'))
## Parsed with column specification:
## cols(
##   fecha = col_character(),
##   confirmados_PCR = col_double(),
##   altas = col_double(),
##   fallecidos = col_double()
## )
## Warning: 94 parsing failures.
## row col  expected    actual                                                            file
##   1  -- 4 columns 6 columns 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDUyfGNmPTAz'
##   2  -- 4 columns 6 columns 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDUyfGNmPTAz'
##   3  -- 4 columns 6 columns 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDUyfGNmPTAz'
##   4  -- 4 columns 6 columns 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDUyfGNmPTAz'
##   5  -- 4 columns 6 columns 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDUyfGNmPTAz'
## ... ... ......... ......... ...............................................................
## See problems(...) for more details.

Revisar esto

Tienen que coincidir las fechas

rioja_evolucion$fecha <- as.Date(rioja_evolucion$fecha, '%m/%d/%y')

Calculamos los acumulados

A la mierda, con un for…

# Valores diarios
rioja_evolucion$acumulado_confirmados <- rioja_evolucion$confirmados_PCR[1]
rioja_evolucion$acumulado_altas       <- rioja_evolucion$altas[1]
rioja_evolucion$acumulado_fallecidos  <- rioja_evolucion$fallecidos[1]

for (i in 2:dim(rioja_evolucion)[1]) {
  rioja_evolucion$acumulado_confirmados[i] <- rioja_evolucion$acumulado_confirmados[i-1] + rioja_evolucion$confirmados_PCR[i]
  rioja_evolucion$acumulado_altas[i]       <- rioja_evolucion$acumulado_altas[i-1] +       rioja_evolucion$altas[i]
  rioja_evolucion$acumulado_fallecidos[i]  <- rioja_evolucion$acumulado_fallecidos[i-1] +  rioja_evolucion$fallecidos[i]
}
rioja_evolucion2 <- rioja_evolucion %>%
  arrange(fecha) %>% 
  mutate(total_confirmados = confirmados_PCR + lag(total_confirmados))

Incorporamos la fecha del dato

rioja_evolucion$fecha_publicacion_evolucion    = as.Date(fecha_valores_evolucion[1], '%d/%m/%Y')
rioja_evolucion$ultima_actualizacion_evolucion = as.Date(fecha_valores_evolucion[2], '%d/%m/%Y')
rioja_evolucion$ambito_temporal_evolucion      = as.Date(fecha_valores_evolucion[3], '%d/%m/%Y')
summary(rioja_evolucion)
##      fecha            confirmados_PCR      altas          fallecidos   
##  Min.   :2020-02-24   Min.   :  0.00   Min.   :  0.00   Min.   : 0.00  
##  1st Qu.:2020-03-18   1st Qu.:  4.25   1st Qu.:  1.00   1st Qu.: 0.00  
##  Median :2020-04-10   Median : 20.00   Median : 35.00   Median : 2.00  
##  Mean   :2020-04-10   Mean   : 43.01   Mean   : 38.96   Mean   : 3.83  
##  3rd Qu.:2020-05-03   3rd Qu.: 60.50   3rd Qu.: 64.50   3rd Qu.: 5.75  
##  Max.   :2020-05-27   Max.   :241.00   Max.   :111.00   Max.   :19.00  
##  acumulado_confirmados acumulado_altas   acumulado_fallecidos
##  Min.   :   0.0        Min.   :   0.00   Min.   :  0.0       
##  1st Qu.: 475.2        1st Qu.:  41.25   1st Qu.:  5.5       
##  Median :3251.0        Median :1378.50   Median :213.0       
##  Mean   :2418.1        Mean   :1391.40   Mean   :184.3       
##  3rd Qu.:3965.5        3rd Qu.:2336.75   3rd Qu.:335.8       
##  Max.   :4043.0        Max.   :3662.00   Max.   :360.0       
##  fecha_publicacion_evolucion ultima_actualizacion_evolucion
##  Min.   :2020-04-28          Min.   :2020-05-29            
##  1st Qu.:2020-04-28          1st Qu.:2020-05-29            
##  Median :2020-04-28          Median :2020-05-29            
##  Mean   :2020-04-28          Mean   :2020-05-29            
##  3rd Qu.:2020-04-28          3rd Qu.:2020-05-29            
##  Max.   :2020-04-28          Max.   :2020-05-29            
##  ambito_temporal_evolucion
##  Min.   :2020-02-24       
##  1st Qu.:2020-02-24       
##  Median :2020-02-24       
##  Mean   :2020-02-24       
##  3rd Qu.:2020-02-24       
##  Max.   :2020-02-24

Guardamos

saveRDS(rioja_evolucion, file = paste0('./data/rioja_evolucion_', Sys.Date(),'.rds'))

Situación de los hospitales de La Rioja

Número de hospitalizados en planta y UCI, por hospitales, a fecha actual

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-461

page_hospitales <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-461')

# find all nodes with a class of "col_md_6"
col_md_6_hospitales <- html_nodes(page_hospitales, css = '.col-md-6')
col_md_6_hospitales
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_hospitales <- html_children(col_md_6_hospitales[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_hospitales
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_hospitales <- html_children(col_md_6_hospitales[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_hospitales
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_hospitales <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDYxfGNmPTAz'
rioja_hospitales <- read_delim(link_hospitales, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   Hospital = col_character(),
##   Total = col_double(),
##   `En planta` = col_double(),
##   UCI = col_double()
## )
rioja_hospitales <- as.data.frame(rioja_hospitales)
names(rioja_hospitales) <- c("hospital", "hospitalizados_total", 
                             "hospitalizados_planta", "hospitalizados_uci")
sum(rioja_hospitales$hospitalizados_total, na.rm = TRUE)
## [1] 21

Creamos una línea con los totales

rioja_hospitales <- rbind(rioja_hospitales, data.frame(hospital = 'Total', 
                                                       hospitalizados_total  = sum(rioja_hospitales$hospitalizados_total, na.rm = TRUE), 
                                                       hospitalizados_planta = sum(rioja_hospitales$hospitalizados_planta, na.rm = TRUE), 
                                                       hospitalizados_uci    = sum(rioja_hospitales$hospitalizados_uci, na.rm = TRUE)))

Incorporamos la fecha del dato

rioja_hospitales$fecha_publicacion_hospitales    = as.Date(fecha_valores_hospitales[1], '%d/%m/%Y')
rioja_hospitales$ultima_actualizacion_hospitales = as.Date(fecha_valores_hospitales[2], '%d/%m/%Y')
rioja_hospitales$ambito_temporal_hospitales      = as.Date(fecha_valores_hospitales[3], '%d/%m/%Y')
summary(rioja_hospitales)
##    hospital         hospitalizados_total hospitalizados_planta
##  Length:5           Min.   : 0.0         Min.   : 0.0         
##  Class :character   1st Qu.: 0.0         1st Qu.: 0.0         
##  Mode  :character   Median : 4.0         Median : 4.0         
##                     Mean   : 8.4         Mean   : 8.4         
##                     3rd Qu.:17.0         3rd Qu.:17.0         
##                     Max.   :21.0         Max.   :21.0         
##                                                               
##  hospitalizados_uci fecha_publicacion_hospitales
##  Min.   :0          Min.   :2020-04-28          
##  1st Qu.:0          1st Qu.:2020-04-28          
##  Median :0          Median :2020-04-28          
##  Mean   :0          Mean   :2020-04-28          
##  3rd Qu.:0          3rd Qu.:2020-04-28          
##  Max.   :0          Max.   :2020-04-28          
##  NA's   :3                                      
##  ultima_actualizacion_hospitales ambito_temporal_hospitales
##  Min.   :2020-05-29              Min.   :2020-02-24        
##  1st Qu.:2020-05-29              1st Qu.:2020-02-24        
##  Median :2020-05-29              Median :2020-02-24        
##  Mean   :2020-05-29              Mean   :2020-02-24        
##  3rd Qu.:2020-05-29              3rd Qu.:2020-02-24        
##  Max.   :2020-05-29              Max.   :2020-02-24        
## 

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(hospitalizados_total               = rioja_hospitales$hospitalizados_total[dim(rioja_hospitales)[1]],
                     hospitalizados_planta              = rioja_hospitales$hospitalizados_planta[dim(rioja_hospitales)[1]],
                     hospitalizados_uci                 = rioja_hospitales$hospitalizados_uci[dim(rioja_hospitales)[1]],
                     
                     hospitalizados_total_s_pedro       = rioja_hospitales$hospitalizados_total[rioja_hospitales$hospital == 'Hospital San Pedro'],
                     hospitalizados_planta_s_pedro      = rioja_hospitales$hospitalizados_planta[rioja_hospitales$hospital == 'Hospital San Pedro'],
                     hospitalizados_uci_s_pedro         = rioja_hospitales$hospitalizados_uci[rioja_hospitales$hospital == 'Hospital San Pedro'],
                     
                     hospitalizados_total_la_rioja      = rioja_hospitales$hospitalizados_total[rioja_hospitales$hospital == 'Hospital de La Rioja'],
                     hospitalizados_planta_la_rioja     = rioja_hospitales$hospitalizados_planta[rioja_hospitales$hospital == 'Hospital de La Rioja'],
                     hospitalizados_uci_la_rioja        = rioja_hospitales$hospitalizados_uci[rioja_hospitales$hospital == 'Hospital de La Rioja'],
                     
                     hospitalizados_total_calahorra     = rioja_hospitales$hospitalizados_total[rioja_hospitales$hospital == 'F. H. Calahorra'],
                     hospitalizados_planta_calahorra    = rioja_hospitales$hospitalizados_planta[rioja_hospitales$hospital == 'F. H. Calahorra'],
                     hospitalizados_uci_calahorra       = rioja_hospitales$hospitalizados_uci[rioja_hospitales$hospital == 'F. H. Calahorra'],
                     
                     hospitalizados_total_manzanos      = rioja_hospitales$hospitalizados_total[rioja_hospitales$hospital == 'Los Manzanos'],
                     hospitalizados_planta_manzanos     = rioja_hospitales$hospitalizados_planta[rioja_hospitales$hospital == 'Los Manzanos'],
                     hospitalizados_uci_manzanos        = rioja_hospitales$hospitalizados_uci[rioja_hospitales$hospital == 'Los Manzanos'],
                     
                     fecha_publicacion_hospitales       = as.Date(fecha_valores_hospitales[1], '%d/%m/%Y'),
                     ultima_actualizacion_hospitales    = as.Date(fecha_valores_hospitales[2], '%d/%m/%Y'),
                     ambito_temporal_hospitales         = as.Date(fecha_valores_hospitales[3], '%d/%m/%Y')
                     )

Sólo pongo los totales. Los datos son semanales

Guardamos

saveRDS(rioja_hospitales, file = paste0('./data/rioja_hospitales_', Sys.Date(),'.rds'))

Añadimos al diario

resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Porcentaje de hospitalizados por grupo de edad y sexo

Porcentaje de hospitalizados por grupo de edad y sexo a a fecha actual

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-453

page_hospitalizados_porcentaje <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-453')

# find all nodes with a class of "col_md_6"
col_md_6_hospitalizados_porcentaje <- html_nodes(page_hospitalizados_porcentaje, css = '.col-md-6')
col_md_6_hospitalizados_porcentaje
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_hospitalizados_porcentaje <- html_children(col_md_6_hospitalizados_porcentaje[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_hospitalizados_porcentaje
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_hospitalizados_porcentaje <- html_children(col_md_6_hospitalizados_porcentaje[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_hospitalizados_porcentaje
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_hospitalizados_porcentaje <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDUzfGNmPTAz'
rioja_hospitalizados_porcentaje <- read_delim(link_hospitalizados_porcentaje, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Warning: Missing column names filled in: 'X4' [4]
## Parsed with column specification:
## cols(
##   `Grupo de edad (años)` = col_character(),
##   Hombres = col_double(),
##   Mujeres = col_double(),
##   X4 = col_logical()
## )
rioja_hospitalizados_porcentaje <- as.data.frame(rioja_hospitalizados_porcentaje)
names(rioja_hospitalizados_porcentaje) <- c("franja_edad", "hombres", 
                             "mujeres", "x4")

Borramos x4

rioja_hospitalizados_porcentaje <- rioja_hospitalizados_porcentaje[, 1:3]

Incorporamos la fecha del dato

rioja_hospitalizados_porcentaje$fecha_publicacion_hospitalizados_porcentaje    = as.Date(fecha_valores_hospitalizados_porcentaje[1], '%d/%m/%Y')
rioja_hospitalizados_porcentaje$ultima_actualizacion_hospitalizados_porcentaje = as.Date(fecha_valores_hospitalizados_porcentaje[2], '%d/%m/%Y')
rioja_hospitalizados_porcentaje$ambito_temporal_hospitalizados_porcentaje      = as.Date(fecha_valores_hospitalizados_porcentaje[3], '%d/%m/%Y')
summary(rioja_hospitalizados_porcentaje)
##  franja_edad           hombres          mujeres      
##  Length:8           Min.   : 0.300   Min.   : 0.700  
##  Class :character   1st Qu.: 1.475   1st Qu.: 1.325  
##  Mode  :character   Median : 6.400   Median : 5.400  
##                     Mean   :12.500   Mean   :12.512  
##                     3rd Qu.:15.700   3rd Qu.:10.475  
##                     Max.   :52.000   Max.   :64.400  
##  fecha_publicacion_hospitalizados_porcentaje
##  Min.   :2020-04-28                         
##  1st Qu.:2020-04-28                         
##  Median :2020-04-28                         
##  Mean   :2020-04-28                         
##  3rd Qu.:2020-04-28                         
##  Max.   :2020-04-28                         
##  ultima_actualizacion_hospitalizados_porcentaje
##  Min.   :2020-05-29                            
##  1st Qu.:2020-05-29                            
##  Median :2020-05-29                            
##  Mean   :2020-05-29                            
##  3rd Qu.:2020-05-29                            
##  Max.   :2020-05-29                            
##  ambito_temporal_hospitalizados_porcentaje
##  Min.   :2020-02-24                       
##  1st Qu.:2020-02-24                       
##  Median :2020-02-24                       
##  Mean   :2020-02-24                       
##  3rd Qu.:2020-02-24                       
##  Max.   :2020-02-24
str(rioja_hospitalizados_porcentaje)
## 'data.frame':    8 obs. of  6 variables:
##  $ franja_edad                                   : chr  "0-9 " "10-19 " "20-29 " "30-39 " ...
##  $ hombres                                       : num  0.3 0.5 1.8 4.6 8.2 15.1 17.5 52
##  $ mujeres                                       : num  0.7 0.8 1.5 4.1 6.7 10 11.9 64.4
##  $ fecha_publicacion_hospitalizados_porcentaje   : Date, format: "2020-04-28" "2020-04-28" ...
##  $ ultima_actualizacion_hospitalizados_porcentaje: Date, format: "2020-05-29" "2020-05-29" ...
##  $ ambito_temporal_hospitalizados_porcentaje     : Date, format: "2020-02-24" "2020-02-24" ...
sum(rioja_hospitalizados_porcentaje$hombres)
## [1] 100
sum(rioja_hospitalizados_porcentaje$mujeres)
## [1] 100.1

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     # hospitalizados_hombres_00_09       = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '0-9 '],
                     # hospitalizados_hombres_10_19       = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '10-19 '],
                     # hospitalizados_hombres_20_19       = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '20-29 '],
                     # hospitalizados_hombres_30_19       = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '30-39 '],
                     # hospitalizados_hombres_40_19       = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '40-49 '],
                     # hospitalizados_hombres_50_19       = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '50-59 '],
                     # hospitalizados_hombres_60_19       = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '60-69 '],
                     # hospitalizados_hombres_70_Mas      = rioja_hospitalizados_porcentaje$hombres[rioja_hospitalizados_porcentaje$franja_edad == '70 y más'],
                     # 
                     # hospitalizados_mujeres_00_09       = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '0-9 '],
                     # hospitalizados_mujeres_10_19       = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '10-19 '],
                     # hospitalizados_mujeres_20_19       = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '20-29 '],
                     # hospitalizados_mujeres_30_19       = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '30-39 '],
                     # hospitalizados_mujeres_40_19       = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '40-49 '],
                     # hospitalizados_mujeres_50_19       = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '50-59 '],
                     # hospitalizados_mujeres_60_19       = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '60-69 '],
                     # hospitalizados_mujeres_70_Mas      = rioja_hospitalizados_porcentaje$mujeres[rioja_hospitalizados_porcentaje$franja_edad == '70 y más'],
                     
                     hospitalizados_hombres_00_09       = rioja_hospitalizados_porcentaje$hombres[1],
                     hospitalizados_hombres_10_19       = rioja_hospitalizados_porcentaje$hombres[2],
                     hospitalizados_hombres_20_19       = rioja_hospitalizados_porcentaje$hombres[3],
                     hospitalizados_hombres_30_19       = rioja_hospitalizados_porcentaje$hombres[4],
                     hospitalizados_hombres_40_19       = rioja_hospitalizados_porcentaje$hombres[5],
                     hospitalizados_hombres_50_19       = rioja_hospitalizados_porcentaje$hombres[6],
                     hospitalizados_hombres_60_19       = rioja_hospitalizados_porcentaje$hombres[7],
                     hospitalizados_hombres_70_Mas      = rioja_hospitalizados_porcentaje$hombres[8],
                     
                     hospitalizados_mujeres_00_09       = rioja_hospitalizados_porcentaje$mujeres[1],
                     hospitalizados_mujeres_10_19       = rioja_hospitalizados_porcentaje$mujeres[2],
                     hospitalizados_mujeres_20_19       = rioja_hospitalizados_porcentaje$mujeres[3],
                     hospitalizados_mujeres_30_19       = rioja_hospitalizados_porcentaje$mujeres[4],
                     hospitalizados_mujeres_40_19       = rioja_hospitalizados_porcentaje$mujeres[5],
                     hospitalizados_mujeres_50_19       = rioja_hospitalizados_porcentaje$mujeres[6],
                     hospitalizados_mujeres_60_19       = rioja_hospitalizados_porcentaje$mujeres[7],
                     hospitalizados_mujeres_70_Mas      = rioja_hospitalizados_porcentaje$mujeres[8],
                     
                     
                     fecha_publicacion_hospitalizados_porcentaje       = as.Date(fecha_valores_hospitalizados_porcentaje[1], '%d/%m/%Y'),
                     ultima_actualizacion_hospitalizados_porcentaje    = as.Date(fecha_valores_hospitalizados_porcentaje[2], '%d/%m/%Y'),
                     ambito_temporal_hospitalizados_porcentaje         = as.Date(fecha_valores_hospitalizados_porcentaje[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_hospitalizados_porcentaje, file = paste0('./data/rioja_hospitalizados_porcentaje_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Porcentaje de hospitalizados en UCI por grupo de edad y sexo

Porcentaje de hospitalizados en UCI por grupo de edad y sexo a fecha actual

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-454

page_uci_porcentaje <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-454')

# find all nodes with a class of "col_md_6"
col_md_6_uci_porcentaje <- html_nodes(page_uci_porcentaje, css = '.col-md-6')
col_md_6_uci_porcentaje
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_uci_porcentaje <- html_children(col_md_6_uci_porcentaje[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_uci_porcentaje
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_uci_porcentaje <- html_children(col_md_6_uci_porcentaje[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_uci_porcentaje
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_uci_porcentaje <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDU0fGNmPTAz'
rioja_uci_porcentaje <- read_delim(link_uci_porcentaje, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Warning: Missing column names filled in: 'X4' [4]
## Parsed with column specification:
## cols(
##   `Grupo de edad (años)` = col_character(),
##   Hombres = col_double(),
##   Mujeres = col_double(),
##   X4 = col_logical()
## )
rioja_uci_porcentaje <- as.data.frame(rioja_uci_porcentaje)
names(rioja_uci_porcentaje) <- c("franja_edad", "hombres", 
                             "mujeres", "x4")

Borramos x4

rioja_uci_porcentaje <- rioja_uci_porcentaje[, 1:3]

Incorporamos la fecha del dato

rioja_uci_porcentaje$fecha_publicacion_uci_porcentaje    = as.Date(fecha_valores_uci_porcentaje[1], '%d/%m/%Y')
rioja_uci_porcentaje$ultima_actualizacion_uci_porcentaje = as.Date(fecha_valores_uci_porcentaje[2], '%d/%m/%Y')
rioja_uci_porcentaje$ambito_temporal_uci_porcentaje      = as.Date(fecha_valores_uci_porcentaje[3], '%d/%m/%Y')
summary(rioja_uci_porcentaje)
##  franja_edad           hombres        mujeres     
##  Length:8           Min.   : 0.0   Min.   : 0.00  
##  Class :character   1st Qu.: 1.5   1st Qu.: 0.00  
##  Mode  :character   Median : 3.0   Median : 4.50  
##                     Mean   :12.5   Mean   :12.49  
##                     3rd Qu.:27.0   3rd Qu.:22.70  
##                     Max.   :36.0   Max.   :45.50  
##  fecha_publicacion_uci_porcentaje ultima_actualizacion_uci_porcentaje
##  Min.   :2020-04-28               Min.   :2020-05-29                 
##  1st Qu.:2020-04-28               1st Qu.:2020-05-29                 
##  Median :2020-04-28               Median :2020-05-29                 
##  Mean   :2020-04-28               Mean   :2020-05-29                 
##  3rd Qu.:2020-04-28               3rd Qu.:2020-05-29                 
##  Max.   :2020-04-28               Max.   :2020-05-29                 
##  ambito_temporal_uci_porcentaje
##  Min.   :2020-02-24            
##  1st Qu.:2020-02-24            
##  Median :2020-02-24            
##  Mean   :2020-02-24            
##  3rd Qu.:2020-02-24            
##  Max.   :2020-02-24
str(rioja_uci_porcentaje)
## 'data.frame':    8 obs. of  6 variables:
##  $ franja_edad                        : chr  "0-9 " "10-19 " "20-29 " "30-39 " ...
##  $ hombres                            : num  2 0 0 2 4 26 36 30
##  $ mujeres                            : num  0 0 0 4.5 4.5 22.7 22.7 45.5
##  $ fecha_publicacion_uci_porcentaje   : Date, format: "2020-04-28" "2020-04-28" ...
##  $ ultima_actualizacion_uci_porcentaje: Date, format: "2020-05-29" "2020-05-29" ...
##  $ ambito_temporal_uci_porcentaje     : Date, format: "2020-02-24" "2020-02-24" ...
sum(rioja_uci_porcentaje$hombres)
## [1] 100
sum(rioja_uci_porcentaje$mujeres)
## [1] 99.9

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     # uci_hombres_00_09       = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '0-9 '],
                     # uci_hombres_10_19       = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '10-19 '],
                     # uci_hombres_20_19       = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '20-29 '],
                     # uci_hombres_30_19       = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '30-39 '],
                     # uci_hombres_40_19       = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '40-49 '],
                     # uci_hombres_50_19       = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '50-59 '],
                     # uci_hombres_60_19       = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '60-69 '],
                     # uci_hombres_70_Mas      = rioja_uci_porcentaje$hombres[rioja_uci_porcentaje$franja_edad == '70 y más'],
                     # 
                     # uci_mujeres_00_09       = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '0-9 '],
                     # uci_mujeres_10_19       = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '10-19 '],
                     # uci_mujeres_20_19       = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '20-29 '],
                     # uci_mujeres_30_19       = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '30-39 '],
                     # uci_mujeres_40_19       = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '40-49 '],
                     # uci_mujeres_50_19       = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '50-59 '],
                     # uci_mujeres_60_19       = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '60-69 '],
                     # uci_mujeres_70_Mas      = rioja_uci_porcentaje$mujeres[rioja_uci_porcentaje$franja_edad == '70 y más'],
                     
                     uci_hombres_00_09       = rioja_uci_porcentaje$hombres[1],
                     uci_hombres_10_19       = rioja_uci_porcentaje$hombres[2],
                     uci_hombres_20_19       = rioja_uci_porcentaje$hombres[3],
                     uci_hombres_30_19       = rioja_uci_porcentaje$hombres[4],
                     uci_hombres_40_19       = rioja_uci_porcentaje$hombres[5],
                     uci_hombres_50_19       = rioja_uci_porcentaje$hombres[6],
                     uci_hombres_60_19       = rioja_uci_porcentaje$hombres[7],
                     uci_hombres_70_Mas      = rioja_uci_porcentaje$hombres[8],
                     
                     uci_mujeres_00_09       = rioja_uci_porcentaje$mujeres[1],
                     uci_mujeres_10_19       = rioja_uci_porcentaje$mujeres[2],
                     uci_mujeres_20_19       = rioja_uci_porcentaje$mujeres[3],
                     uci_mujeres_30_19       = rioja_uci_porcentaje$mujeres[4],
                     uci_mujeres_40_19       = rioja_uci_porcentaje$mujeres[5],
                     uci_mujeres_50_19       = rioja_uci_porcentaje$mujeres[6],
                     uci_mujeres_60_19       = rioja_uci_porcentaje$mujeres[7],
                     uci_mujeres_70_Mas      = rioja_uci_porcentaje$mujeres[8],
                     
                     
                     fecha_publicacion_uci_porcentaje       = as.Date(fecha_valores_uci_porcentaje[1], '%d/%m/%Y'),
                     ultima_actualizacion_uci_porcentaje    = as.Date(fecha_valores_uci_porcentaje[2], '%d/%m/%Y'),
                     ambito_temporal_uci_porcentaje         = as.Date(fecha_valores_uci_porcentaje[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_uci_porcentaje, file = paste0('./data/rioja_uci_porcentaje_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Porcentaje de fallecidos por grupo de edad y sexo

Porcentaje de fallecidos por grupo de edad y sexo a fecha actual

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-455

page_fallecidos_porcentaje <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-455')

# find all nodes with a class of "col_md_6"
col_md_6_fallecidos_porcentaje <- html_nodes(page_fallecidos_porcentaje, css = '.col-md-6')
col_md_6_fallecidos_porcentaje
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_fallecidos_porcentaje <- html_children(col_md_6_fallecidos_porcentaje[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_fallecidos_porcentaje
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_fallecidos_porcentaje <- html_children(col_md_6_fallecidos_porcentaje[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_fallecidos_porcentaje
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_fallecidos_porcentaje <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDU1fGNmPTAz'
rioja_fallecidos_porcentaje <- read_delim(link_fallecidos_porcentaje, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Warning: Missing column names filled in: 'X4' [4]
## Parsed with column specification:
## cols(
##   `Grupo de edad (años)` = col_character(),
##   Hombres = col_double(),
##   Mujeres = col_double(),
##   X4 = col_logical()
## )
rioja_fallecidos_porcentaje <- as.data.frame(rioja_fallecidos_porcentaje)
names(rioja_fallecidos_porcentaje) <- c("franja_edad", "hombres", 
                             "mujeres", "x4")

Borramos x4

rioja_fallecidos_porcentaje <- rioja_fallecidos_porcentaje[, 1:3]

Incorporamos la fecha del dato

rioja_fallecidos_porcentaje$fecha_publicacion_fallecidos_porcentaje    = as.Date(fecha_valores_fallecidos_porcentaje[1], '%d/%m/%Y')
rioja_fallecidos_porcentaje$ultima_actualizacion_fallecidos_porcentaje = as.Date(fecha_valores_fallecidos_porcentaje[2], '%d/%m/%Y')
rioja_fallecidos_porcentaje$ambito_temporal_fallecidos_porcentaje      = as.Date(fecha_valores_fallecidos_porcentaje[3], '%d/%m/%Y')
summary(rioja_fallecidos_porcentaje)
##  franja_edad           hombres          mujeres      
##  Length:8           Min.   : 0.000   Min.   : 0.000  
##  Class :character   1st Qu.: 0.000   1st Qu.: 0.000  
##  Mode  :character   Median : 1.250   Median : 0.300  
##                     Mean   :12.488   Mean   :12.500  
##                     3rd Qu.: 5.275   3rd Qu.: 1.925  
##                     Max.   :82.700   Max.   :94.300  
##  fecha_publicacion_fallecidos_porcentaje
##  Min.   :2020-04-28                     
##  1st Qu.:2020-04-28                     
##  Median :2020-04-28                     
##  Mean   :2020-04-28                     
##  3rd Qu.:2020-04-28                     
##  Max.   :2020-04-28                     
##  ultima_actualizacion_fallecidos_porcentaje
##  Min.   :2020-05-29                        
##  1st Qu.:2020-05-29                        
##  Median :2020-05-29                        
##  Mean   :2020-05-29                        
##  3rd Qu.:2020-05-29                        
##  Max.   :2020-05-29                        
##  ambito_temporal_fallecidos_porcentaje
##  Min.   :2020-02-24                   
##  1st Qu.:2020-02-24                   
##  Median :2020-02-24                   
##  Mean   :2020-02-24                   
##  3rd Qu.:2020-02-24                   
##  Max.   :2020-02-24
str(rioja_fallecidos_porcentaje)
## 'data.frame':    8 obs. of  6 variables:
##  $ franja_edad                               : chr  "0-9 " "10-19 " "20-29 " "30-39 " ...
##  $ hombres                                   : num  0 0 0 0.6 1.9 3.2 11.5 82.7
##  $ mujeres                                   : num  0 0 0 0.6 1.3 0 3.8 94.3
##  $ fecha_publicacion_fallecidos_porcentaje   : Date, format: "2020-04-28" "2020-04-28" ...
##  $ ultima_actualizacion_fallecidos_porcentaje: Date, format: "2020-05-29" "2020-05-29" ...
##  $ ambito_temporal_fallecidos_porcentaje     : Date, format: "2020-02-24" "2020-02-24" ...
sum(rioja_fallecidos_porcentaje$hombres)
## [1] 99.9
sum(rioja_fallecidos_porcentaje$mujeres)
## [1] 100

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     # fallecidos_hombres_00_09       = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '0-9 '],
                     # fallecidos_hombres_10_19       = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '10-19 '],
                     # fallecidos_hombres_20_19       = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '20-29 '],
                     # fallecidos_hombres_30_19       = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '30-39 '],
                     # fallecidos_hombres_40_19       = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '40-49 '],
                     # fallecidos_hombres_50_19       = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '50-59 '],
                     # fallecidos_hombres_60_19       = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '60-69 '],
                     # fallecidos_hombres_70_Mas      = rioja_fallecidos_porcentaje$hombres[rioja_fallecidos_porcentaje$franja_edad == '70 y más'],
                     # 
                     # fallecidos_mujeres_00_09       = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '0-9 '],
                     # fallecidos_mujeres_10_19       = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '10-19 '],
                     # fallecidos_mujeres_20_19       = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '20-29 '],
                     # fallecidos_mujeres_30_19       = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '30-39 '],
                     # fallecidos_mujeres_40_19       = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '40-49 '],
                     # fallecidos_mujeres_50_19       = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '50-59 '],
                     # fallecidos_mujeres_60_19       = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '60-69 '],
                     # fallecidos_mujeres_70_Mas      = rioja_fallecidos_porcentaje$mujeres[rioja_fallecidos_porcentaje$franja_edad == '70 y más'],
                     
                     fallecidos_hombres_00_09       = rioja_fallecidos_porcentaje$hombres[1],
                     fallecidos_hombres_10_19       = rioja_fallecidos_porcentaje$hombres[2],
                     fallecidos_hombres_20_19       = rioja_fallecidos_porcentaje$hombres[3],
                     fallecidos_hombres_30_19       = rioja_fallecidos_porcentaje$hombres[4],
                     fallecidos_hombres_40_19       = rioja_fallecidos_porcentaje$hombres[5],
                     fallecidos_hombres_50_19       = rioja_fallecidos_porcentaje$hombres[6],
                     fallecidos_hombres_60_19       = rioja_fallecidos_porcentaje$hombres[7],
                     fallecidos_hombres_70_Mas      = rioja_fallecidos_porcentaje$hombres[8],
                     
                     fallecidos_mujeres_00_09       = rioja_fallecidos_porcentaje$mujeres[1],
                     fallecidos_mujeres_10_19       = rioja_fallecidos_porcentaje$mujeres[2],
                     fallecidos_mujeres_20_19       = rioja_fallecidos_porcentaje$mujeres[3],
                     fallecidos_mujeres_30_19       = rioja_fallecidos_porcentaje$mujeres[4],
                     fallecidos_mujeres_40_19       = rioja_fallecidos_porcentaje$mujeres[5],
                     fallecidos_mujeres_50_19       = rioja_fallecidos_porcentaje$mujeres[6],
                     fallecidos_mujeres_60_19       = rioja_fallecidos_porcentaje$mujeres[7],
                     fallecidos_mujeres_70_Mas      = rioja_fallecidos_porcentaje$mujeres[8],
                     
                     
                     fecha_publicacion_fallecidos_porcentaje       = as.Date(fecha_valores_fallecidos_porcentaje[1], '%d/%m/%Y'),
                     ultima_actualizacion_fallecidos_porcentaje    = as.Date(fecha_valores_fallecidos_porcentaje[2], '%d/%m/%Y'),
                     ambito_temporal_fallecidos_porcentaje         = as.Date(fecha_valores_fallecidos_porcentaje[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_fallecidos_porcentaje, file = paste0('./data/rioja_fallecidos_porcentaje_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Porcentaje de casos por grupos de edad

Porcentaje de casos por grupo de edad y sexo a fecha actual

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-456

page_casos_porcentaje <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-456')

# find all nodes with a class of "col_md_6"
col_md_6_casos_porcentaje <- html_nodes(page_casos_porcentaje, css = '.col-md-6')
col_md_6_casos_porcentaje
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_casos_porcentaje <- html_children(col_md_6_casos_porcentaje[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_casos_porcentaje
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_casos_porcentaje <- html_children(col_md_6_casos_porcentaje[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_casos_porcentaje
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_casos_porcentaje <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDU2fGNmPTAz'
rioja_casos_porcentaje <- read_delim(link_casos_porcentaje, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Warning: Missing column names filled in: 'X4' [4]
## Parsed with column specification:
## cols(
##   `Grupo de edad (años)` = col_character(),
##   Hombres = col_double(),
##   Mujeres = col_double(),
##   X4 = col_logical()
## )
rioja_casos_porcentaje <- as.data.frame(rioja_casos_porcentaje)
names(rioja_casos_porcentaje) <- c("franja_edad", "hombres", 
                             "mujeres", "x4")

Borramos x4

rioja_casos_porcentaje <- rioja_casos_porcentaje[, 1:3]

Incorporamos la fecha del dato

rioja_casos_porcentaje$fecha_publicacion_casos_porcentaje    = as.Date(fecha_valores_casos_porcentaje[1], '%d/%m/%Y')
rioja_casos_porcentaje$ultima_actualizacion_casos_porcentaje = as.Date(fecha_valores_casos_porcentaje[2], '%d/%m/%Y')
rioja_casos_porcentaje$ambito_temporal_casos_porcentaje      = as.Date(fecha_valores_casos_porcentaje[3], '%d/%m/%Y')
summary(rioja_casos_porcentaje)
##  franja_edad           hombres          mujeres      
##  Length:8           Min.   : 0.700   Min.   : 0.700  
##  Class :character   1st Qu.: 4.125   1st Qu.: 5.125  
##  Mode  :character   Median :11.300   Median :11.150  
##                     Mean   :12.500   Mean   :12.512  
##                     3rd Qu.:15.950   3rd Qu.:16.025  
##                     Max.   :37.600   Max.   :36.700  
##  fecha_publicacion_casos_porcentaje ultima_actualizacion_casos_porcentaje
##  Min.   :2020-04-28                 Min.   :2020-05-29                   
##  1st Qu.:2020-04-28                 1st Qu.:2020-05-29                   
##  Median :2020-04-28                 Median :2020-05-29                   
##  Mean   :2020-04-28                 Mean   :2020-05-29                   
##  3rd Qu.:2020-04-28                 3rd Qu.:2020-05-29                   
##  Max.   :2020-04-28                 Max.   :2020-05-29                   
##  ambito_temporal_casos_porcentaje
##  Min.   :2020-02-24              
##  1st Qu.:2020-02-24              
##  Median :2020-02-24              
##  Mean   :2020-02-24              
##  3rd Qu.:2020-02-24              
##  Max.   :2020-02-24
str(rioja_casos_porcentaje)
## 'data.frame':    8 obs. of  6 variables:
##  $ franja_edad                          : chr  "0-9 " "10-19 " "20-29 " "30-39 " ...
##  $ hombres                              : num  0.7 1.2 5.1 9.7 12.9 17.3 15.5 37.6
##  $ mujeres                              : num  0.7 1.3 6.4 10.8 15.7 17 11.5 36.7
##  $ fecha_publicacion_casos_porcentaje   : Date, format: "2020-04-28" "2020-04-28" ...
##  $ ultima_actualizacion_casos_porcentaje: Date, format: "2020-05-29" "2020-05-29" ...
##  $ ambito_temporal_casos_porcentaje     : Date, format: "2020-02-24" "2020-02-24" ...
sum(rioja_casos_porcentaje$hombres)
## [1] 100
sum(rioja_casos_porcentaje$mujeres)
## [1] 100.1

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     # casos_hombres_00_09       = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '0-9 '],
                     # casos_hombres_10_19       = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '10-19 '],
                     # casos_hombres_20_19       = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '20-29 '],
                     # casos_hombres_30_19       = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '30-39 '],
                     # casos_hombres_40_19       = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '40-49 '],
                     # casos_hombres_50_19       = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '50-59 '],
                     # casos_hombres_60_19       = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '60-69 '],
                     # casos_hombres_70_Mas      = rioja_casos_porcentaje$hombres[rioja_casos_porcentaje$franja_edad == '70 y más'],
                     # 
                     # casos_mujeres_00_09       = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '0-9 '],
                     # casos_mujeres_10_19       = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '10-19 '],
                     # casos_mujeres_20_19       = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '20-29 '],
                     # casos_mujeres_30_19       = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '30-39 '],
                     # casos_mujeres_40_19       = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '40-49 '],
                     # casos_mujeres_50_19       = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '50-59 '],
                     # casos_mujeres_60_19       = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '60-69 '],
                     # casos_mujeres_70_Mas      = rioja_casos_porcentaje$mujeres[rioja_casos_porcentaje$franja_edad == '70 y más'],
                     
                     casos_hombres_00_09       = rioja_casos_porcentaje$hombres[1],
                     casos_hombres_10_19       = rioja_casos_porcentaje$hombres[2],
                     casos_hombres_20_19       = rioja_casos_porcentaje$hombres[3],
                     casos_hombres_30_19       = rioja_casos_porcentaje$hombres[4],
                     casos_hombres_40_19       = rioja_casos_porcentaje$hombres[5],
                     casos_hombres_50_19       = rioja_casos_porcentaje$hombres[6],
                     casos_hombres_60_19       = rioja_casos_porcentaje$hombres[7],
                     casos_hombres_70_Mas      = rioja_casos_porcentaje$hombres[8],
                     
                     casos_mujeres_00_09       = rioja_casos_porcentaje$mujeres[1],
                     casos_mujeres_10_19       = rioja_casos_porcentaje$mujeres[2],
                     casos_mujeres_20_19       = rioja_casos_porcentaje$mujeres[3],
                     casos_mujeres_30_19       = rioja_casos_porcentaje$mujeres[4],
                     casos_mujeres_40_19       = rioja_casos_porcentaje$mujeres[5],
                     casos_mujeres_50_19       = rioja_casos_porcentaje$mujeres[6],
                     casos_mujeres_60_19       = rioja_casos_porcentaje$mujeres[7],
                     casos_mujeres_70_Mas      = rioja_casos_porcentaje$mujeres[8],
                     
                     
                     fecha_publicacion_casos_porcentaje       = as.Date(fecha_valores_casos_porcentaje[1], '%d/%m/%Y'),
                     ultima_actualizacion_casos_porcentaje    = as.Date(fecha_valores_casos_porcentaje[2], '%d/%m/%Y'),
                     ambito_temporal_casos_porcentaje         = as.Date(fecha_valores_casos_porcentaje[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_casos_porcentaje, file = paste0('./data/rioja_casos_porcentaje_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Pruebas realizadas en La Rioja

Pruebas realizadas en La Rioja (PCR y pruebas rápidas de anticuerpos)

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-462

page_pruebas <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-462')

# find all nodes with a class of "col_md_6"
col_md_6_pruebas <- html_nodes(page_pruebas, css = '.col-md-6')
col_md_6_pruebas
fecha_campos_pruebas <- html_children(col_md_6_pruebas[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_pruebas
fecha_valores_pruebas <- html_children(col_md_6_pruebas[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_pruebas

Ahora bajamos el fichero

link_pruebas <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDYyfGNmPTAz'
rioja_pruebas <- read_delim(link_pruebas, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
rioja_pruebas <- as.data.frame(rioja_pruebas)
names(rioja_pruebas) <- c("tipo_prueba", "total_pruebas", "pruebas_positivas", 
                          "Porcentaje_pruebas_positivas")

Incorporamos la fecha del dato

rioja_pruebas$fecha_publicacion_pruebas    = as.Date(fecha_valores_pruebas[1], '%d/%m/%Y')
rioja_pruebas$ultima_actualizacion_pruebas = as.Date(fecha_valores_pruebas[2], '%d/%m/%Y')
rioja_pruebas$ambito_temporal_pruebas      = as.Date(fecha_valores_pruebas[3], '%d/%m/%Y')
summary(rioja_pruebas)

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     pcr_realizadas                  = rioja_pruebas$total_pruebas[1],
                     pcr_positivos                   = rioja_pruebas$pruebas_positivas[1],
                     pruebas_rapidas_anticuerpos     = rioja_pruebas$total_pruebas[2],
                     pruebas_rapidas_positivas       = rioja_pruebas$pruebas_positivas[2],

                     fecha_publicacion_pruebas       = as.Date(fecha_valores_pruebas[1], '%d/%m/%Y'),
                     ultima_actualizacion_pruebas    = as.Date(fecha_valores_pruebas[2], '%d/%m/%Y'),
                     ambito_temporal_pruebas         = as.Date(fecha_valores_pruebas[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_pruebas, file = paste0('./data/rioja_pruebas_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Pruebas realizadas en La Rioja

Cambia el formato de la web. A partir de 2020-05-18 no se dan datos de positivos

Pruebas realizadas en La Rioja (PCR y pruebas rápidas de anticuerpos)

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-462

page_pruebas <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-462')

# find all nodes with a class of "col_md_6"
col_md_6_pruebas <- html_nodes(page_pruebas, css = '.col-md-6')
col_md_6_pruebas
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_pruebas <- html_children(col_md_6_pruebas[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_pruebas
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_pruebas <- html_children(col_md_6_pruebas[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_pruebas
## [1] "29/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_pruebas <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDYyfGNmPTAz'
rioja_pruebas <- read_delim(link_pruebas, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   Pruebas = col_character(),
##   `Total de pruebas` = col_double(),
##   `Tasa de pruebas por 1.000 habitantes` = col_double()
## )
rioja_pruebas <- as.data.frame(rioja_pruebas)
names(rioja_pruebas) <- c("pruebas", "total_pruebas", "pruebas_por_1000_hab")

Incorporamos la fecha del dato

rioja_pruebas$fecha_publicacion_pruebas    = as.Date(fecha_valores_pruebas[1], '%d/%m/%Y')
rioja_pruebas$ultima_actualizacion_pruebas = as.Date(fecha_valores_pruebas[2], '%d/%m/%Y')
rioja_pruebas$ambito_temporal_pruebas      = as.Date(fecha_valores_pruebas[3], '%d/%m/%Y')
summary(rioja_pruebas)
##    pruebas          total_pruebas   pruebas_por_1000_hab
##  Length:2           Min.   :17885   Min.   :56.90       
##  Class :character   1st Qu.:20772   1st Qu.:66.08       
##  Mode  :character   Median :23658   Median :75.25       
##                     Mean   :23658   Mean   :75.25       
##                     3rd Qu.:26545   3rd Qu.:84.42       
##                     Max.   :29432   Max.   :93.60       
##  fecha_publicacion_pruebas ultima_actualizacion_pruebas ambito_temporal_pruebas
##  Min.   :2020-04-29        Min.   :2020-05-29           Min.   :2020-02-24     
##  1st Qu.:2020-04-29        1st Qu.:2020-05-29           1st Qu.:2020-02-24     
##  Median :2020-04-29        Median :2020-05-29           Median :2020-02-24     
##  Mean   :2020-04-29        Mean   :2020-05-29           Mean   :2020-02-24     
##  3rd Qu.:2020-04-29        3rd Qu.:2020-05-29           3rd Qu.:2020-02-24     
##  Max.   :2020-04-29        Max.   :2020-05-29           Max.   :2020-02-24

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     pcr_realizadas                  = rioja_pruebas$total_pruebas[1],
                     # pcr_positivos                   = rioja_pruebas$pruebas_positivas[1],
                     pruebas_rapidas_anticuerpos     = rioja_pruebas$total_pruebas[2],
                     # pruebas_rapidas_positivas       = rioja_pruebas$pruebas_positivas[2],
                     pruebas_pcr_por_1000_hab        = rioja_pruebas$pruebas_por_1000_hab[1],
                     pruebas_rapidas_por_1000_hab    = rioja_pruebas$pruebas_por_1000_hab[2],   

                     fecha_publicacion_pruebas       = as.Date(fecha_valores_pruebas[1], '%d/%m/%Y'),
                     ultima_actualizacion_pruebas    = as.Date(fecha_valores_pruebas[2], '%d/%m/%Y'),
                     ambito_temporal_pruebas         = as.Date(fecha_valores_pruebas[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_pruebas, file = paste0('./data/rioja_pruebas_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Salidas domiciliarias

Datos de salidas domiciliarias por día realizadas en La Rioja. Incluye fecha y número de salidas

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-463

page_salidas_domiciliarias <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-463')

# find all nodes with a class of "col_md_6"
col_md_6_salidas_domiciliarias <- html_nodes(page_salidas_domiciliarias, css = '.col-md-6')
col_md_6_salidas_domiciliarias
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_salidas_domiciliarias <- html_children(col_md_6_salidas_domiciliarias[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_salidas_domiciliarias
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_salidas_domiciliarias <- html_children(col_md_6_salidas_domiciliarias[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_salidas_domiciliarias
## [1] "29/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 29/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_salidas_domiciliarias <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDYzfGNmPTAz'
rioja_salidas_domiciliarias <- read_delim(link_salidas_domiciliarias, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   FECHA = col_character(),
##   `SALIDAS DOMICILIARIAS` = col_double()
## )
rioja_salidas_domiciliarias <- as.data.frame(rioja_salidas_domiciliarias)
names(rioja_salidas_domiciliarias) <- c("fecha", "salidas_domiciliarias")

Revisar esto

Tienen que coincidir las fechas

rioja_salidas_domiciliarias$fecha = as.Date(rioja_salidas_domiciliarias$fecha, '%m/%d/%Y')

Calculamos los acumulados

# Valores diarios
rioja_salidas_domiciliarias$acumulado_salidas_domiciliarias <- 0

for (i in 2:dim(rioja_salidas_domiciliarias)[1]) {
  rioja_salidas_domiciliarias$acumulado_salidas_domiciliarias[i] <- rioja_salidas_domiciliarias$acumulado_salidas_domiciliarias[i-1] + rioja_salidas_domiciliarias$salidas_domiciliarias[i]
}

Incorporamos la fecha del dato

rioja_salidas_domiciliarias$fecha_publicacion_salidas_domiciliarias    = as.Date(fecha_valores_salidas_domiciliarias[1], '%d/%m/%Y')
rioja_salidas_domiciliarias$ultima_actualizacion_salidas_domiciliarias = as.Date(fecha_valores_salidas_domiciliarias[2], '%d/%m/%Y')
rioja_salidas_domiciliarias$ambito_temporal_salidas_domiciliarias      = as.Date(fecha_valores_salidas_domiciliarias[3], '%d/%m/%Y')
summary(rioja_salidas_domiciliarias)
##      fecha          salidas_domiciliarias acumulado_salidas_domiciliarias
##  Min.   :20-02-24   Min.   :  0.00        Min.   :   0                   
##  1st Qu.:20-03-18   1st Qu.: 16.00        1st Qu.:1173                   
##  Median :20-04-10   Median : 38.50        Median :2990                   
##  Mean   :20-04-10   Mean   : 44.67        Mean   :2502                   
##  3rd Qu.:20-05-03   3rd Qu.: 67.75        3rd Qu.:3837                   
##  Max.   :20-05-27   Max.   :139.00        Max.   :4199                   
##  fecha_publicacion_salidas_domiciliarias
##  Min.   :2020-04-29                     
##  1st Qu.:2020-04-29                     
##  Median :2020-04-29                     
##  Mean   :2020-04-29                     
##  3rd Qu.:2020-04-29                     
##  Max.   :2020-04-29                     
##  ultima_actualizacion_salidas_domiciliarias
##  Min.   :2020-05-29                        
##  1st Qu.:2020-05-29                        
##  Median :2020-05-29                        
##  Mean   :2020-05-29                        
##  3rd Qu.:2020-05-29                        
##  Max.   :2020-05-29                        
##  ambito_temporal_salidas_domiciliarias
##  Min.   :2020-02-24                   
##  1st Qu.:2020-02-24                   
##  Median :2020-02-24                   
##  Mean   :2020-02-24                   
##  3rd Qu.:2020-02-24                   
##  Max.   :2020-02-24

Guardamos

saveRDS(rioja_salidas_domiciliarias, file = paste0('./data/rioja_salidas_domiciliarias_', Sys.Date(),'.rds'))

Autoevaluaciones en el servicio online realizadas en La Rioja

Datos de autoevaluaciones en el servicio online coronavirus.riojasalud.es realizadas por día en La Rioja. Incluye fecha y número de autoevaluaciones

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-464

page_autoevaluaciones_online <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-464')

# find all nodes with a class of "col_md_6"
col_md_6_autoevaluaciones_online <- html_nodes(page_autoevaluaciones_online, css = '.col-md-6')
col_md_6_autoevaluaciones_online
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_autoevaluaciones_online <- html_children(col_md_6_autoevaluaciones_online[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_autoevaluaciones_online
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_autoevaluaciones_online <- html_children(col_md_6_autoevaluaciones_online[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_autoevaluaciones_online
## [1] "29/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "01/04/2020"                                                                   
## [4] "Fecha de creación: 29/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_autoevaluaciones_online <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDY0fGNmPTAz'
rioja_autoevaluaciones_online <- read_delim(link_autoevaluaciones_online, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   FECHA = col_character(),
##   AUTOEVALUACIÓN = col_double()
## )
rioja_autoevaluaciones_online <- as.data.frame(rioja_autoevaluaciones_online)
names(rioja_autoevaluaciones_online) <- c("fecha", "autoevaluaciones_online")

Revisar esto

Tienen que coincidir las fechas

rioja_autoevaluaciones_online$fecha = as.Date(rioja_autoevaluaciones_online$fecha, '%m/%d/%Y')

Calculamos los acumulados

# Valores diarios
rioja_autoevaluaciones_online$acumulado_autoevaluaciones_online <- 0

for (i in 2:dim(rioja_autoevaluaciones_online)[1]) {
  rioja_autoevaluaciones_online$acumulado_autoevaluaciones_online[i] <- rioja_autoevaluaciones_online$acumulado_autoevaluaciones_online[i-1] + rioja_autoevaluaciones_online$autoevaluaciones_online[i]
}

Incorporamos la fecha del dato

rioja_autoevaluaciones_online$fecha_publicacion_autoevaluaciones_online    = as.Date(fecha_valores_autoevaluaciones_online[1], '%d/%m/%Y')
rioja_autoevaluaciones_online$ultima_actualizacion_autoevaluaciones_online = as.Date(fecha_valores_autoevaluaciones_online[2], '%d/%m/%Y')
rioja_autoevaluaciones_online$ambito_temporal_autoevaluaciones_online      = as.Date(fecha_valores_autoevaluaciones_online[3], '%d/%m/%Y')
summary(rioja_autoevaluaciones_online)
##      fecha          autoevaluaciones_online acumulado_autoevaluaciones_online
##  Min.   :20-04-01   Min.   :  1.00          Min.   :   0                     
##  1st Qu.:20-04-15   1st Qu.:  8.00          1st Qu.: 747                     
##  Median :20-04-29   Median : 18.00          Median : 896                     
##  Mean   :20-04-29   Mean   : 98.09          Mean   :1481                     
##  3rd Qu.:20-05-13   3rd Qu.:158.00          3rd Qu.:1966                     
##  Max.   :20-05-27   Max.   :647.00          Max.   :5005                     
##  fecha_publicacion_autoevaluaciones_online
##  Min.   :2020-04-29                       
##  1st Qu.:2020-04-29                       
##  Median :2020-04-29                       
##  Mean   :2020-04-29                       
##  3rd Qu.:2020-04-29                       
##  Max.   :2020-04-29                       
##  ultima_actualizacion_autoevaluaciones_online
##  Min.   :2020-05-29                          
##  1st Qu.:2020-05-29                          
##  Median :2020-05-29                          
##  Mean   :2020-05-29                          
##  3rd Qu.:2020-05-29                          
##  Max.   :2020-05-29                          
##  ambito_temporal_autoevaluaciones_online
##  Min.   :2020-04-01                     
##  1st Qu.:2020-04-01                     
##  Median :2020-04-01                     
##  Mean   :2020-04-01                     
##  3rd Qu.:2020-04-01                     
##  Max.   :2020-04-01

Guardamos

saveRDS(rioja_autoevaluaciones_online, file = paste0('./data/rioja_autoevaluaciones_online_', Sys.Date(),'.rds'))

Personal afectado del Servicio Público de Salud de La Rioja

Casos activos y porcentaje sobre el total de trabajadores sanitarios a fecha actual

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-457

page_casos_activos_sanitarios <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-457')

# find all nodes with a class of "col_md_6"
col_md_6_sanitarios <- html_nodes(page_casos_activos_sanitarios, css = '.col-md-6')
col_md_6_sanitarios
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_sanitarios <- html_children(col_md_6_sanitarios[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_sanitarios
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_sanitarios <- html_children(col_md_6_sanitarios[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_sanitarios
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_personal_sanitario <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDU3fGNmPTAz'
rioja_personal_sanitario <- read_delim(link_personal_sanitario, ",", escape_double = FALSE, trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   `Categoría laboral` = col_character(),
##   `Casos activos` = col_double(),
##   Altas = col_double(),
##   `Casos acumulados` = col_double()
## )
rioja_personal_sanitario <- as.data.frame(rioja_personal_sanitario)
names(rioja_personal_sanitario) <- c("sanitarios_categoria_laboral", 
                                     "sanitarios_casos_activos",
                                     "sanitarios_altas", 
                                     "sanitarios_casos_acumulados")
sum(rioja_personal_sanitario$casos_activos)
## [1] 0

Incorporamos la fecha del dato

rioja_personal_sanitario$fecha_publicacion_sanitarios    = as.Date(fecha_valores_sanitarios[1], '%d/%m/%Y')
rioja_personal_sanitario$ultima_actualizacion_sanitarios = as.Date(fecha_valores_sanitarios[2], '%d/%m/%Y')
rioja_personal_sanitario$ambito_temporal_sanitarios      = as.Date(fecha_valores_sanitarios[3], '%d/%m/%Y')
summary(rioja_personal_sanitario)
##  sanitarios_categoria_laboral sanitarios_casos_activos sanitarios_altas
##  Length:7                     Min.   :0.0000           Min.   : 18.00  
##  Class :character             1st Qu.:0.0000           1st Qu.: 27.00  
##  Mode  :character             Median :0.0000           Median : 71.00  
##                               Mean   :0.5714           Mean   : 97.43  
##                               3rd Qu.:1.0000           3rd Qu.: 99.00  
##                               Max.   :2.0000           Max.   :341.00  
##  sanitarios_casos_acumulados fecha_publicacion_sanitarios
##  Min.   : 18.00              Min.   :2020-04-28          
##  1st Qu.: 26.00              1st Qu.:2020-04-28          
##  Median : 71.00              Median :2020-04-28          
##  Mean   : 96.86              Mean   :2020-04-28          
##  3rd Qu.: 99.00              3rd Qu.:2020-04-28          
##  Max.   :339.00              Max.   :2020-04-28          
##  ultima_actualizacion_sanitarios ambito_temporal_sanitarios
##  Min.   :2020-05-29              Min.   :2020-02-24        
##  1st Qu.:2020-05-29              1st Qu.:2020-02-24        
##  Median :2020-05-29              Median :2020-02-24        
##  Mean   :2020-05-29              Mean   :2020-02-24        
##  3rd Qu.:2020-05-29              3rd Qu.:2020-02-24        
##  Max.   :2020-05-29              Max.   :2020-02-24

Revisar que cuadra

diario <- data.frame(sanitarios_casos_activos_diario    = rioja_personal_sanitario$sanitarios_casos_activos[rioja_personal_sanitario$sanitarios_categoria_laboral == 'Total'],
                     sanitarios_casos_activos_altas     = rioja_personal_sanitario$sanitarios_altas[rioja_personal_sanitario$sanitarios_categoria_laboral == 'Total'],
                     sanitarios_casos_activos_acumulado = rioja_personal_sanitario$sanitarios_casos_acumulados[rioja_personal_sanitario$sanitarios_categoria_laboral == 'Total'],
                     fecha_publicacion_sanitarios       = as.Date(fecha_valores_sanitarios[1], '%d/%m/%Y'),
                     ultima_actualizacion_sanitarios    = as.Date(fecha_valores_sanitarios[2], '%d/%m/%Y'),
                     ambito_temporal_sanitarios         = as.Date(fecha_valores_sanitarios[3], '%d/%m/%Y')
                     )

Sólo pongo los totales. Los datos son semanales

Guardamos

saveRDS(rioja_personal_sanitario, file = paste0('./data/rioja_personal_sanitario_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Fallecimientos por días

Evolución diaria del número de fallecimientos, con indicación de los ocurridos en residencias

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-458

page_casos_activos_fallecidos <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-458')

# find all nodes with a class of "col_md_6"
col_md_6_fallecidos <- html_nodes(page_casos_activos_fallecidos, css = '.col-md-6')
col_md_6_fallecidos
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_fallecidos <- html_children(col_md_6_fallecidos[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_fallecidos
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_fallecidos <- html_children(col_md_6_fallecidos[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_fallecidos
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "09/03/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_fallecidos <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDU4fGNmPTAz'
rioja_fallecidos <- read_delim(link_fallecidos, ",", escape_double = FALSE, trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   FECHA = col_character(),
##   TOTALES = col_double(),
##   RESIDENCIAS = col_double()
## )
rioja_fallecidos <- as.data.frame(rioja_fallecidos)
names(rioja_fallecidos) <- c("fecha", "fallecidos_totales", 
                             "fallecidos_residencias")

Revisar esto

Tienen que coincidir las fechas

rioja_fallecidos$fecha <- as.Date(rioja_fallecidos$fecha, '%m/%d/%y')

Calculamos los acumulados

# Valores diarios
rioja_fallecidos$acumulado_fallecidos_totales     <- rioja_fallecidos$fallecidos_totales[1]
rioja_fallecidos$acumulado_fallecidos_residencias <- rioja_fallecidos$fallecidos_residencias[1]

for (i in 2:dim(rioja_fallecidos)[1]) {
  rioja_fallecidos$acumulado_fallecidos_totales[i]     <- rioja_fallecidos$acumulado_fallecidos_totales[i-1] + rioja_fallecidos$fallecidos_totales[i]
  rioja_fallecidos$acumulado_fallecidos_residencias[i] <- rioja_fallecidos$acumulado_fallecidos_residencias[i-1] + rioja_fallecidos$fallecidos_residencias[i]
}

Incorporamos la fecha del dato

rioja_fallecidos$fecha_publicacion_fallecidos    = as.Date(fecha_valores_fallecidos[1], '%d/%m/%Y')
rioja_fallecidos$ultima_actualizacion_fallecidos = as.Date(fecha_valores_fallecidos[2], '%d/%m/%Y')
rioja_fallecidos$ambito_temporal_fallecidos      = as.Date(fecha_valores_fallecidos[3], '%d/%m/%Y')
summary(rioja_fallecidos)
##      fecha            fallecidos_totales fallecidos_residencias
##  Min.   :2020-03-09   Min.   : 0.0       Min.   : 0.000        
##  1st Qu.:2020-03-28   1st Qu.: 1.0       1st Qu.: 0.000        
##  Median :2020-04-17   Median : 3.0       Median : 1.000        
##  Mean   :2020-04-17   Mean   : 4.5       Mean   : 2.587        
##  3rd Qu.:2020-05-07   3rd Qu.: 7.0       3rd Qu.: 4.000        
##  Max.   :2020-05-27   Max.   :19.0       Max.   :14.000        
##  NA's   :79           NA's   :79         NA's   :79            
##  acumulado_fallecidos_totales acumulado_fallecidos_residencias
##  Min.   :  1.00               Min.   :  0.00                  
##  1st Qu.: 70.25               1st Qu.: 20.25                  
##  Median :274.50               Median :151.00                  
##  Mean   :216.50               Mean   :117.49                  
##  3rd Qu.:342.50               3rd Qu.:196.25                  
##  Max.   :360.00               Max.   :207.00                  
##  NA's   :79                   NA's   :79                      
##  fecha_publicacion_fallecidos ultima_actualizacion_fallecidos
##  Min.   :2020-04-28           Min.   :2020-05-29             
##  1st Qu.:2020-04-28           1st Qu.:2020-05-29             
##  Median :2020-04-28           Median :2020-05-29             
##  Mean   :2020-04-28           Mean   :2020-05-29             
##  3rd Qu.:2020-04-28           3rd Qu.:2020-05-29             
##  Max.   :2020-04-28           Max.   :2020-05-29             
##                                                              
##  ambito_temporal_fallecidos
##  Min.   :2020-03-09        
##  1st Qu.:2020-03-09        
##  Median :2020-03-09        
##  Mean   :2020-03-09        
##  3rd Qu.:2020-03-09        
##  Max.   :2020-03-09        
## 

Guardamos

saveRDS(rioja_fallecidos, file = paste0('./data/rioja_fallecidos_', Sys.Date(),'.rds'))
# Change the width of bars
ggplot(data = rioja_fallecidos, aes(x = fecha, y = acumulado_fallecidos_totales)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = acumulado_fallecidos_totales), vjust = -0.3, size = 1.5)+
  theme_minimal()

# Change the width of bars
ggplot(data = rioja_fallecidos, aes(x = fecha, y = fallecidos_totales)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = fallecidos_totales), vjust = -0.3, size = 1.5)+
  theme_minimal()

# Change the width of bars
ggplot(data = rioja_fallecidos, aes(x = fecha, y = acumulado_fallecidos_residencias)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = acumulado_fallecidos_totales), vjust = -0.3, size = 1.5)+
  theme_minimal()

# Change the width of bars
ggplot(data = rioja_fallecidos, aes(x = fecha, y = fallecidos_residencias)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = fallecidos_totales), vjust = -0.3, size = 1.5)+
  theme_minimal()

Consultas telefónicas atendidas en La Rioja

Llamadas al teléfono 941 298 333 para atender consultas sobre COVID-19. Incluye fecha y número de llamadas atendidas

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-465

page_llamadas <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-465')

# find all nodes with a class of "col_md_6"
col_md_6_llamadas <- html_nodes(page_llamadas, css = '.col-md-6')
col_md_6_llamadas
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_llamadas <- html_children(col_md_6_llamadas[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_llamadas
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_llamadas <- html_children(col_md_6_llamadas[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_llamadas
## [1] "29/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 29/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_llamadas <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDY1fGNmPTAz'
rioja_llamadas <- read_delim(link_llamadas, ",", escape_double = FALSE, trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   FECHA = col_character(),
##   LLAMADAS = col_double()
## )
names(rioja_llamadas) <- tolower(names(rioja_llamadas))

Revisar esto

Tienen que coincidir las fechas

rioja_llamadas$fecha <- as.Date(rioja_llamadas$fecha, '%m/%d/%y')

Calculamos los acumulados

# Valores diarios
rioja_llamadas$acumulado_llamadas <- 0

for (i in 2:dim(rioja_llamadas)[1]) {
  rioja_llamadas$acumulado_llamadas[i] <- rioja_llamadas$acumulado_llamadas[i-1] + rioja_llamadas$llamadas[i]
}

Incorporamos la fecha del dato

rioja_llamadas$fecha_publicacion_llamadas    = as.Date(fecha_valores_llamadas[1], '%d/%m/%Y')
rioja_llamadas$ultima_actualizacion_llamadas = as.Date(fecha_valores_llamadas[2], '%d/%m/%Y')
rioja_llamadas$ambito_temporal_llamadas      = as.Date(fecha_valores_llamadas[3], '%d/%m/%Y')
summary(rioja_llamadas)
##      fecha               llamadas     acumulado_llamadas
##  Min.   :2020-02-24   Min.   :  0.0   Min.   :    0     
##  1st Qu.:2020-03-18   1st Qu.: 92.5   1st Qu.: 7408     
##  Median :2020-04-10   Median :163.0   Median :15403     
##  Mean   :2020-04-10   Mean   :221.1   Mean   :12936     
##  3rd Qu.:2020-05-03   3rd Qu.:296.2   3rd Qu.:18776     
##  Max.   :2020-05-27   Max.   :873.0   Max.   :20780     
##  fecha_publicacion_llamadas ultima_actualizacion_llamadas
##  Min.   :2020-04-29         Min.   :2020-05-29           
##  1st Qu.:2020-04-29         1st Qu.:2020-05-29           
##  Median :2020-04-29         Median :2020-05-29           
##  Mean   :2020-04-29         Mean   :2020-05-29           
##  3rd Qu.:2020-04-29         3rd Qu.:2020-05-29           
##  Max.   :2020-04-29         Max.   :2020-05-29           
##  ambito_temporal_llamadas
##  Min.   :2020-02-24      
##  1st Qu.:2020-02-24      
##  Median :2020-02-24      
##  Mean   :2020-02-24      
##  3rd Qu.:2020-02-24      
##  Max.   :2020-02-24

Guardamos

saveRDS(rioja_llamadas, file = paste0('./data/rioja_llamadas_', Sys.Date(),'.rds'))

Ritmo de reproducción (R0)

Ritmo de reproducción de la pandemia en La Rioja. Incluye fecha y valor R0 (Número personas que contagia cada caso confirmado)

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-466

page_ritmo_reproduccion_r0 <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-466')

# find all nodes with a class of "col_md_6"
col_md_6_ritmo_reproduccion_r0 <- html_nodes(page_ritmo_reproduccion_r0 , css = '.col-md-6')
col_md_6_ritmo_reproduccion_r0
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_ritmo_reproduccion_r0 <- html_children(col_md_6_ritmo_reproduccion_r0[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_ritmo_reproduccion_r0
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_ritmo_reproduccion_r0 <- html_children(col_md_6_ritmo_reproduccion_r0[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_ritmo_reproduccion_r0
## [1] "04/05/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "08/03/2020"                                                                   
## [4] "Fecha de creación: 04/05/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_ritmo_reproduccion_r0 <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDY2fGNmPTAz'
rioja_ritmo_reproduccion_r0 <- read_delim(link_ritmo_reproduccion_r0, ",", escape_double = FALSE, trim_ws = TRUE)
## Warning: Missing column names filled in: 'X3' [3]
## Parsed with column specification:
## cols(
##   fecha = col_character(),
##   R0 = col_double(),
##   X3 = col_logical()
## )
names(rioja_ritmo_reproduccion_r0) <- tolower(names(rioja_ritmo_reproduccion_r0))
rioja_ritmo_reproduccion_r0 <- as.data.frame(rioja_ritmo_reproduccion_r0)

Borramos x3

rioja_ritmo_reproduccion_r0 <- rioja_ritmo_reproduccion_r0[, 1:2]

Revisar esto

Tienen que coincidir las fechas

rioja_ritmo_reproduccion_r0$fecha <- as.Date(rioja_ritmo_reproduccion_r0$fecha, '%m/%d/%y')

Calculamos los acumulados

# Valores diarios
rioja_ritmo_reproduccion_r0$acumulado_ritmo_reproduccion_r0 <- 0

for (i in 2:dim(rioja_ritmo_reproduccion_r0)[1]) {
  rioja_ritmo_reproduccion_r0$acumulado_ritmo_reproduccion_r0[i] <- rioja_ritmo_reproduccion_r0$acumulado_ritmo_reproduccion_r0[i-1] + rioja_ritmo_reproduccion_r0$ritmo_reproduccion_r0[i]
}

Incorporamos la fecha del dato

rioja_ritmo_reproduccion_r0$fecha_publicacion_ritmo_reproduccion_r0    = as.Date(fecha_valores_ritmo_reproduccion_r0[1], '%d/%m/%Y')
rioja_ritmo_reproduccion_r0$ultima_actualizacion_ritmo_reproduccion_r0 = as.Date(fecha_valores_ritmo_reproduccion_r0[2], '%d/%m/%Y')
rioja_ritmo_reproduccion_r0$ambito_temporal_ritmo_reproduccion_r0      = as.Date(fecha_valores_ritmo_reproduccion_r0[3], '%d/%m/%Y')
summary(rioja_ritmo_reproduccion_r0)
##      fecha                  r0        fecha_publicacion_ritmo_reproduccion_r0
##  Min.   :2020-03-08   Min.   :0.410   Min.   :2020-05-04                     
##  1st Qu.:2020-03-28   1st Qu.:0.710   1st Qu.:2020-05-04                     
##  Median :2020-04-17   Median :0.830   Median :2020-05-04                     
##  Mean   :2020-04-17   Mean   :1.066   Mean   :2020-05-04                     
##  3rd Qu.:2020-05-07   3rd Qu.:1.160   3rd Qu.:2020-05-04                     
##  Max.   :2020-05-27   Max.   :4.240   Max.   :2020-05-04                     
##  ultima_actualizacion_ritmo_reproduccion_r0
##  Min.   :2020-05-29                        
##  1st Qu.:2020-05-29                        
##  Median :2020-05-29                        
##  Mean   :2020-05-29                        
##  3rd Qu.:2020-05-29                        
##  Max.   :2020-05-29                        
##  ambito_temporal_ritmo_reproduccion_r0
##  Min.   :2020-03-08                   
##  1st Qu.:2020-03-08                   
##  Median :2020-03-08                   
##  Mean   :2020-03-08                   
##  3rd Qu.:2020-03-08                   
##  Max.   :2020-03-08

Guardamos

saveRDS(rioja_ritmo_reproduccion_r0, file = paste0('./data/rioja_ritmo_reproduccion_r0_', Sys.Date(),'.rds'))

Situación de las residencias de personas mayores de La Rioja

Situación a fecha actual de las residencias de personas mayores de La Rioja

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-468

page_situacion_personas_mayores <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-468')

# find all nodes with a class of "col_md_6"
col_md_6_situacion_personas_mayores <- html_nodes(page_situacion_personas_mayores, css = '.col-md-6')
col_md_6_situacion_personas_mayores
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_situacion_personas_mayores <- html_children(col_md_6_situacion_personas_mayores[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_situacion_personas_mayores
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_situacion_personas_mayores <- html_children(col_md_6_situacion_personas_mayores[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_situacion_personas_mayores
## [1] "07/05/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "07/05/2020"                                                                   
## [4] "Fecha de creación: 07/05/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_situacion_personas_mayores <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDY4fGNmPTAz'
rioja_situacion_personas_mayores <- read_delim(link_situacion_personas_mayores, ",", escape_double = FALSE, 
                               na = c("", "NA", "-"), col_names = FALSE, trim_ws = TRUE)      # OJO con el col_names ************************************
## Parsed with column specification:
## cols(
##   X1 = col_character(),
##   X2 = col_character()
## )
rioja_situacion_personas_mayores <- as.data.frame(rioja_situacion_personas_mayores)
names(rioja_situacion_personas_mayores) <- c("franja_edad", "hombres", 
                             "mujeres", "x4")

Borramos x4

rioja_situacion_personas_mayores <- rioja_situacion_personas_mayores[, 1:3]

Incorporamos la fecha del dato

rioja_situacion_personas_mayores$fecha_publicacion_situacion_personas_mayores    = as.Date(fecha_valores_situacion_personas_mayores[1], '%d/%m/%Y')
rioja_situacion_personas_mayores$ultima_actualizacion_situacion_personas_mayores = as.Date(fecha_valores_situacion_personas_mayores[2], '%d/%m/%Y')
rioja_situacion_personas_mayores$ambito_temporal_situacion_personas_mayores      = as.Date(fecha_valores_situacion_personas_mayores[3], '%d/%m/%Y')
summary(rioja_situacion_personas_mayores)
##       X1                 X2           
##  Length:7           Length:7          
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
##                                       
##  fecha_publicacion_situacion_personas_mayores
##  Min.   :2020-05-07                          
##  1st Qu.:2020-05-07                          
##  Median :2020-05-07                          
##  Mean   :2020-05-07                          
##  3rd Qu.:2020-05-07                          
##  Max.   :2020-05-07                          
##  ultima_actualizacion_situacion_personas_mayores
##  Min.   :2020-05-29                             
##  1st Qu.:2020-05-29                             
##  Median :2020-05-29                             
##  Mean   :2020-05-29                             
##  3rd Qu.:2020-05-29                             
##  Max.   :2020-05-29                             
##  ambito_temporal_situacion_personas_mayores
##  Min.   :2020-05-07                        
##  1st Qu.:2020-05-07                        
##  Median :2020-05-07                        
##  Mean   :2020-05-07                        
##  3rd Qu.:2020-05-07                        
##  Max.   :2020-05-07
str(rioja_situacion_personas_mayores)
## 'data.frame':    7 obs. of  5 variables:
##  $ X1                                             : chr  "Casos confirmados por PCR" "Altas" "Fallecidos" "Residentes libres de coronavirus" ...
##  $ X2                                             : chr  "35" "826" "207" "100%" ...
##  $ fecha_publicacion_situacion_personas_mayores   : Date, format: "2020-05-07" "2020-05-07" ...
##  $ ultima_actualizacion_situacion_personas_mayores: Date, format: "2020-05-29" "2020-05-29" ...
##  $ ambito_temporal_situacion_personas_mayores     : Date, format: "2020-05-07" "2020-05-07" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   X1 = col_character(),
##   ..   X2 = col_character()
##   .. )

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     
                     mayores_confirmados_PCR       = as.numeric(rioja_situacion_personas_mayores$X2[1]),
                     mayores_altas_acumulado       = as.numeric(rioja_situacion_personas_mayores$X2[2]),
                     mayores_fallecidos_acumulado  = as.numeric(rioja_situacion_personas_mayores$X2[3]),
                     residentes_sin_coronavirus    = rioja_situacion_personas_mayores$X2[4],
                     residencias_sin_positivos     = as.numeric(rioja_situacion_personas_mayores$X2[5]),
                     
                     fecha_publicacion_situacion_personas_mayores       = as.Date(fecha_valores_situacion_personas_mayores[1], '%d/%m/%Y'),
                     ultima_actualizacion_situacion_personas_mayores    = as.Date(fecha_valores_situacion_personas_mayores[2], '%d/%m/%Y'),
                     ambito_temporal_situacion_personas_mayores         = as.Date(fecha_valores_situacion_personas_mayores[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_situacion_personas_mayores, file = paste0('./data/rioja_situacion_personas_mayores_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Casos confirmados acumulados por localidades

Casos confirmados de coronavirus acumulados a fecha actual, por localidades

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-470

page_casos_acumulados_localidades <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-470')

# find all nodes with a class of "col_md_6"
col_md_6_casos_acumulados_localidades <- html_nodes(page_casos_acumulados_localidades, css = '.col-md-6')
col_md_6_casos_acumulados_localidades
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_casos_acumulados_localidades <- html_children(col_md_6_casos_acumulados_localidades[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_casos_acumulados_localidades
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_casos_acumulados_localidades <- html_children(col_md_6_casos_acumulados_localidades[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_casos_acumulados_localidades
## [1] "21/05/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 21/05/2020 Fecha de actualización de los datos: 25/05/2020"

Ahora bajamos el fichero

link_casos_acumulados_localidades <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDcwfGNmPTAz'
rioja_casos_acumulados_localidades <- read_delim(link_casos_acumulados_localidades, ";", escape_double = FALSE, 
                               na = c("", "NA", "-"), col_names = TRUE, trim_ws = TRUE)      # OJO con el col_names ************************************
## Parsed with column specification:
## cols(
##   ID = col_character(),
##   Value = col_character()
## )
rioja_casos_acumulados_localidades <- as.data.frame(rioja_casos_acumulados_localidades)
names(rioja_casos_acumulados_localidades) <- c("franja_edad", "hombres", 
                             "mujeres", "x4")
rioja_casos_acumulados_localidades <- rioja_casos_acumulados_localidades[, 1:3]

Incorporamos la fecha del dato

rioja_casos_acumulados_localidades$fecha_publicacion_casos_acumulados_localidades    = as.Date(fecha_valores_casos_acumulados_localidades[1], '%d/%m/%Y')
rioja_casos_acumulados_localidades$ultima_actualizacion_casos_acumulados_localidades = as.Date(fecha_valores_casos_acumulados_localidades[2], '%d/%m/%Y')
rioja_casos_acumulados_localidades$ambito_temporal_casos_acumulados_localidades      = as.Date(fecha_valores_casos_acumulados_localidades[3], '%d/%m/%Y')
summary(rioja_casos_acumulados_localidades)
##       ID               Value          
##  Length:175         Length:175        
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
##                                       
##  fecha_publicacion_casos_acumulados_localidades
##  Min.   :2020-05-21                            
##  1st Qu.:2020-05-21                            
##  Median :2020-05-21                            
##  Mean   :2020-05-21                            
##  3rd Qu.:2020-05-21                            
##  Max.   :2020-05-21                            
##  ultima_actualizacion_casos_acumulados_localidades
##  Min.   :2020-05-29                               
##  1st Qu.:2020-05-29                               
##  Median :2020-05-29                               
##  Mean   :2020-05-29                               
##  3rd Qu.:2020-05-29                               
##  Max.   :2020-05-29                               
##  ambito_temporal_casos_acumulados_localidades
##  Min.   :2020-02-24                          
##  1st Qu.:2020-02-24                          
##  Median :2020-02-24                          
##  Mean   :2020-02-24                          
##  3rd Qu.:2020-02-24                          
##  Max.   :2020-02-24
str(rioja_casos_acumulados_localidades)
## 'data.frame':    175 obs. of  5 variables:
##  $ ID                                               : chr  "Grañón" "Herce" "Herramélluri" "Hervías" ...
##  $ Value                                            : chr  "<10" "<10" "<10" "<10" ...
##  $ fecha_publicacion_casos_acumulados_localidades   : Date, format: "2020-05-21" "2020-05-21" ...
##  $ ultima_actualizacion_casos_acumulados_localidades: Date, format: "2020-05-29" "2020-05-29" ...
##  $ ambito_temporal_casos_acumulados_localidades     : Date, format: "2020-02-24" "2020-02-24" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   ID = col_character(),
##   ..   Value = col_character()
##   .. )

Revisar que cuadra

# En esta caso es la última línea
diario <- data.frame(
                     
                     mayores_confirmados_PCR       = as.numeric(rioja_casos_acumulados_localidades$X2[1]),
                     mayores_altas_acumulado       = as.numeric(rioja_casos_acumulados_localidades$X2[2]),
                     mayores_fallecidos_acumulado  = as.numeric(rioja_casos_acumulados_localidades$X2[3]),
                     residentes_sin_coronavirus    = rioja_casos_acumulados_localidades$X2[4],
                     residencias_sin_positivos     = as.numeric(rioja_casos_acumulados_localidades$X2[5]),
                     
                     fecha_publicacion_casos_acumulados_localidades       = as.Date(fecha_valores_casos_acumulados_localidades[1], '%d/%m/%Y'),
                     ultima_actualizacion_casos_acumulados_localidades    = as.Date(fecha_valores_casos_acumulados_localidades[2], '%d/%m/%Y'),
                     ambito_temporal_casos_acumulados_localidades         = as.Date(fecha_valores_casos_acumulados_localidades[3], '%d/%m/%Y')
                     )

Guardamos

saveRDS(rioja_casos_acumulados_localidades, file = paste0('./data/rioja_casos_acumulados_localidades_', Sys.Date(),'.rds'))

Añadimos al diario

# resumen_diario <- data.frame(time_stamp = Sys.time())
resumen_diario <- cbind(resumen_diario, diario)

Situación por Zonas Básicas de Salud

Casos activos de coronavirus, a fecha actual, por zonas básicas de salud (geolocalizadas: coordenadas de latitud y longitud)

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-460

page_casos_activos_zonas_basicas <- read_html('https://web.larioja.org/dato-abierto/datoabierto?n=opd-460')

# find all nodes with a class of "col_md_6"
col_md_6_zonas <- html_nodes(page_casos_activos_zonas_basicas, css = '.col-md-6')
col_md_6_zonas
## {xml_nodeset (8)}
## [1] <li class="col-md-6"><a href="/participacion"><span class="fas fa-lg fa-u ...
## [2] <li class="col-md-6"><a href="/quejas-y-sugerencias"><span class="fas fa- ...
## [3] <li class="col-md-6"><a href="/suscripciones"><span class="fas fa-lg fa-b ...
## [4] <li class="col-md-6"><a href="/contacto"><span class="fas fa-lg fa-envelo ...
## [5] <li class="col-md-6"><a href="https://www.larioja.org/direcciones-utiles/ ...
## [6] <li class="col-md-6"><a href="https://www.larioja.org/oficina-electronica ...
## [7] <div class="col-md-6">\n                        <dl>\n<dt>Creador</dt>\n  ...
## [8] <div class="col-md-6">\n                        <dl>\n<dt>Fecha de public ...
fecha_campos_zonas <- html_children(col_md_6_zonas[8]) %>% 
    html_nodes("dt") %>% 
    html_text(trim = TRUE)
fecha_campos_zonas
## [1] "Fecha de publicación:" "Última actualización:" "Ámbito temporal"      
## [4] "Cronología"
fecha_valores_zonas <- html_children(col_md_6_zonas[8]) %>% 
    html_nodes("dd") %>% 
    html_text(trim = TRUE)
fecha_valores_zonas
## [1] "28/04/2020"                                                                   
## [2] "29/05/2020"                                                                   
## [3] "24/02/2020"                                                                   
## [4] "Fecha de creación: 28/04/2020 Fecha de actualización de los datos: 28/05/2020"

Ahora bajamos el fichero

link_casos_activos_zonas_basicas <- 'https://ias1.larioja.org/opendata/download?r=Y2Q9NDYwfGNmPTAz'
rioja_casos_activos_zonas_basicas <- read_delim(link_casos_activos_zonas_basicas, 
                                              ";", escape_double = FALSE, trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   Lat = col_double(),
##   Lon = col_double(),
##   Title = col_character(),
##   NOMBRE = col_character(),
##   `CASOS ACTIVOS` = col_double()
## )
names(rioja_casos_activos_zonas_basicas) <- c("latitud", "longitud", "localidad",
                                              "nombre_zbs", "casos_activos")

Incorporamos la fecha del dato

rioja_casos_activos_zonas_basicas$fecha_publicacion_zonas    = as.Date(fecha_valores_zonas[1], '%d/%m/%Y')
rioja_casos_activos_zonas_basicas$ultima_actualizacion_zonas = as.Date(fecha_valores_zonas[2], '%d/%m/%Y')
rioja_casos_activos_zonas_basicas$ambito_temporal_zonas      = as.Date(fecha_valores_zonas[3], '%d/%m/%Y')
sum(rioja_casos_activos_zonas_basicas$casos_activos)
## [1] 3279

Revisar que cuadra

Pasamos a incorporar los datos diarios

diario <- data.frame(casos_activos_aberite      = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Alberite'],
                     casos_activos_alfaro       = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Alfaro'],
                     casos_activos_arnedo       = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Arnedo'],
                     casos_activos_calahorra    = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Calahorra'],
                     casos_activos_cervera      = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Cervera del Río Alhama'],
                     casos_activos_haro         = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Haro'],
                     casos_activos_logrono      = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Logroño'],
                     casos_activos_murillo      = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Murillo del Río Leza'],
                     casos_activos_najera       = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Nájera'],
                     casos_activos_navarrete    = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Navarrete'],
                     casos_activos_san_roman    = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'San Román de Cameros'],
                     casos_activos_s_domingo    = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Santo Domingo de la Calzada'],
                     casos_activos_torrecilla   = rioja_casos_activos_zonas_basicas$casos_activos[rioja_casos_activos_zonas_basicas$localidad == 'Torrecilla en Cameros'],
                     fecha_publicacion_zonas    = as.Date(fecha_valores_zonas[1], '%d/%m/%Y'),
                     ultima_actualizacion_zonas = as.Date(fecha_valores_zonas[2], '%d/%m/%Y'),
                     ambito_temporal_zonas      = as.Date(fecha_valores_zonas[3], '%d/%m/%Y')
                     )
resumen_diario <- cbind(resumen_diario, diario)

Guardamos

saveRDS(rioja_casos_activos_zonas_basicas, file = paste0('./data/rioja_casos_activos_zonas_basicas_', Sys.Date(),'.rds'))

Hacemos un mapa

Le asigno un CRS “a capón”, el de OSM

rioja_casos_activos_zonas_basicas_shp <-  sf::st_as_sf(as.data.frame(rioja_casos_activos_zonas_basicas), 
                                                       coords = c('longitud', 'latitud'), 
                                                       crs = 4326)
# tmap object
mapa_casos_activos_zonas_basicas <- tm_shape(rioja_casos_activos_zonas_basicas_shp) +
    tm_dots("casos_activos")

# dynamic map
tmap_leaflet(mapa_casos_activos_zonas_basicas)
# cat(getwd())

rioja_zonas_basicas_shp <- sf::read_sf('./data/maps/ZBS_4258_LARIOJA_ESPAÑA_2017_v1.0.0/laRioja4258.shp',
                                      stringsAsFactors = TRUE)

Para poder hacer merge, creamos la variable localidad

rioja_zonas_basicas_shp$localidad <- rioja_zonas_basicas_shp$n_zbs
levels(rioja_zonas_basicas_shp$localidad) <- c("Alberite", "Alfaro", "Arnedo",
                                               "Calahorra", "Torrecilla en Cameros",
                                               "San Román de Cameros", 
                                               "Cervera del Río Alhama",  "Haro",
                                               "Logroño", "Murillo del Río Leza",
                                               "Nájera", "Navarrete" ,
                                               "Santo Domingo de la Calzada")
summary(rioja_zonas_basicas_shp)
##     codatzbs                                         n_zbs            geometry 
##  Min.   :130101   Alberite - Albelda de Iregua          :1   MULTIPOLYGON :13  
##  1st Qu.:130104   Alfaro                                :1   epsg:4258    : 0  
##  Median :130107   Arnedo                                :1   +proj=long...: 0  
##  Mean   :130107   Calahorra                             :1                     
##  3rd Qu.:130110   Cameros Nuevos (Torrecilla en Cameros):1                     
##  Max.   :130113   Cameros Viejos (San Román de Cameros) :1                     
##                   (Other)                               :7                     
##                  localidad
##  Alberite             :1  
##  Alfaro               :1  
##  Arnedo               :1  
##  Calahorra            :1  
##  Torrecilla en Cameros:1  
##  San Román de Cameros :1  
##  (Other)              :7
plot(rioja_zonas_basicas_shp)

# Este mapa no parece bien...

# tmap object
mapa_casos_activos_zonas_basicas2 <- 
    
    tm_shape(rioja_zonas_basicas_shp) +
    tm_polygons(id          = "localidad", 
                # col         = "numberOfFloorsAboveGround", 
                border.col  = "blue",
                # palette     = col.spec.fun(15),
                alpha       = 0.5, 
                legend.show = FALSE,
                textNA      = "Sin datos",
                title       = "Localidad") +
  
    # tm_shape(rioja_casos_activos_zonas_basicas_shp) +
    # tm_dots("casos_activos")

    tm_shape(rioja_casos_activos_zonas_basicas_shp) +
    tm_dots(# id   = "localidad",
            title = "casos activos",
            size  = "casos_activos", 
            id    = "casos_activos"
            )
  

# dynamic map
tmap_leaflet(mapa_casos_activos_zonas_basicas2)

Resumen diario

Guardamos el resumen diario

saveRDS(resumen_diario, file = paste0('./data/resumen_diario_', Sys.Date(),'.rds'))
# ZBS Madrid

madrid_zonas_basicas_shp <- sf::read_sf('./data/maps/ZBS_Madrid/200001380.shp',
                                      stringsAsFactors = TRUE)

Pendientes

Datos globales

Datos globales de la pandemia de coronavirus: tasa de letalidad; tasa de hospitalización (casos activos y casos acumulados); y porcentaje de altas acumuladas

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-459

Donaciones económicas

Movimientos en la cuenta de donaciones económicas recibidas por el Gobierno de La Rioja durante la pandemia del coronavirus Covid-19

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-467

Contratos de emergencia

Contratos de emergencia realizados durante la pandemia del coronavirus Covid-19 debidos a situaciones excepcionales. Incluye organismo, expediente, descripción, fecha, lotes, empresa, contenido, unidades e importe

La página de datos abiertos es esta: https://web.larioja.org/dato-abierto/datoabierto?n=opd-469

Datos de ISCIII

Serie historica

Los datos de (ISCIII)[https://covid19.isciii.es/]

link_isciii <- 'https://covid19.isciii.es/resources/serie_historica_acumulados.csv'
link_isciii <- 'https://cnecovid.isciii.es/covid19/resources/agregados.csv'

En los datos en local se han eliminado las últimas filas que corresponden a comentarios.

# Datos en local
serie_historica_acumulados_isciii <- read_csv("data/serie_historica_acumulados.csv", 
                                              locale = locale(date_names = "es"))
# Directamente de Internet
serie_historica_acumulados_isciii <- read_csv(link_isciii, 
                                              locale = locale(date_names = "es"))
## Parsed with column specification:
## cols(
##   CCAA = col_character(),
##   FECHA = col_character(),
##   CASOS = col_double(),
##   `PCR+` = col_double(),
##   `TestAc+` = col_double(),
##   Hospitalizados = col_double(),
##   UCI = col_double(),
##   Fallecidos = col_double()
## )
## Warning: 1 parsing failure.
##  row col  expected    actual                                                         file
## 1738  -- 8 columns 9 columns 'https://cnecovid.isciii.es/covid19/resources/agregados.csv'
serie_historica_acumulados_isciii <- as.data.frame(serie_historica_acumulados_isciii)

El csv incluye comentarios al final, vamos a quitarlos

# Donde aparece por primera vez 'NOTA'
ultima_linea <- min((1:dim(serie_historica_acumulados_isciii)[1])[str_detect(serie_historica_acumulados_isciii$CCAA, 'NOTA')])
ultima_linea
## [1] 1730
serie_historica_acumulados_isciii <- serie_historica_acumulados_isciii[(1:(ultima_linea-1)), ]

Vemos los datos por CC.AA.

table(serie_historica_acumulados_isciii$CCAA, useNA = 'ifany')
## 
## AN AR AS CB CE CL CM CN CT EX GA IB MC MD ML NC PV RI VC 
## 91 91 91 91 91 91 91 91 91 91 91 91 91 91 91 91 91 91 91

Comunidades autónomas

serie_historica_acumulados_isciii$CCAA <- factor(serie_historica_acumulados_isciii$CCAA, 
                                                 levels = c('AN', 'AR', 'AS', 'CB', 'CE', 
                                                            'CL', 'CM', 'CN', 'CT', 'EX', 
                                                            'GA', 'IB', 'MC', 'MD', 'ML', 
                                                            'NC', 'PV', 'RI', 'VC'),
                                                 labels = c('Andalucía', 'Aragón', 
                                                            'Asturias, Principado de', 
                                                            'Cantabria', 'Ceuta', 
                                                            'Castilla y León', 
                                                            'Castilla - La Mancha', 
                                                            'Canarias', 'Cantabria', 
                                                            'Extremadura', 
                                                            'Galicia', 'Balears, Illes', 
                                                            'Murcia, Región de', 
                                                            'Madrid, Comunidad de', 
                                                            'Melilla', 
                                                            'Navarra, Comunidad Foral de', 
                                                            'País Vasco', 'Rioja, La', 
                                                            'Comunitat Valenciana'))

Pasamos la fecha a formato Date

serie_historica_acumulados_isciii$FECHA <- as.Date(serie_historica_acumulados_isciii$FECHA, "%d/%m/%Y")

Nuevas columnas

# Valores diarios
serie_historica_acumulados_isciii <- serie_historica_acumulados_isciii %>% 
  group_by(CCAA) %>% 
  arrange(FECHA) %>% 
  mutate(diario_hospitalizados = Hospitalizados - lag(Hospitalizados, order_by = FECHA),
         diario_uci            = UCI - lag(UCI, order_by = FECHA),
         diario_fallecidos     = Fallecidos - lag(Fallecidos, order_by = FECHA)
         # diario_recuperados    = Recuperados - lag(Recuperados) # Este es acumulado
  )

Cantabria está duplicado

Revisar

summary(serie_historica_acumulados_isciii)
##                       CCAA          FECHA                CASOS     
##  Cantabria              : 182   Min.   :2020-02-20   Min.   :0     
##  Andalucía              :  91   1st Qu.:2020-03-13   1st Qu.:0     
##  Aragón                 :  91   Median :2020-04-05   Median :0     
##  Asturias, Principado de:  91   Mean   :2020-04-05   Mean   :0     
##  Ceuta                  :  91   3rd Qu.:2020-04-28   3rd Qu.:0     
##  Castilla y León        :  91   Max.   :2020-05-20   Max.   :0     
##  (Other)                :1092                        NA's   :1728  
##       PCR+          TestAc+     Hospitalizados       UCI        
##  Min.   :    0   Min.   :   0   Min.   :    0   Min.   :   0.0  
##  1st Qu.:   71   1st Qu.: 114   1st Qu.:  260   1st Qu.:  29.0  
##  Median : 1752   Median : 873   Median : 1080   Median : 118.0  
##  Mean   : 6323   Mean   :1509   Mean   : 4182   Mean   : 399.4  
##  3rd Qu.: 5858   3rd Qu.:2023   3rd Qu.: 4397   3rd Qu.: 420.5  
##  Max.   :67049   Max.   :8634   Max.   :42497   Max.   :3617.0  
##                  NA's   :1036   NA's   :328     NA's   :298     
##    Fallecidos     diario_hospitalizados   diario_uci        diario_fallecidos 
##  Min.   :   0.0   Min.   :-28461.00     Min.   :-2890.000   Min.   :-5812.00  
##  1st Qu.:  17.0   1st Qu.:     2.00     1st Qu.:    0.000   1st Qu.:    0.00  
##  Median : 197.0   Median :    19.00     Median :    1.000   Median :    5.00  
##  Mean   : 810.5   Mean   :    88.71     Mean   :    7.994   Mean   :   19.85  
##  3rd Qu.: 773.0   3rd Qu.:    68.00     3rd Qu.:    7.000   3rd Qu.:   19.00  
##  Max.   :8931.0   Max.   : 28461.00     Max.   : 2890.000   Max.   : 5812.00  
##  NA's   :315      NA's   :347           NA's   :316         NA's   :333

Guardamos

saveRDS(serie_historica_acumulados_isciii, file = paste0('./data/serie_historica_acumulados_isciii_', Sys.Date(),'.rds'))

MoMo ISCIII

Los modelos MoMo del ISCIII.

Los datos están disponibles aquí en formato CSV, y se actualizan diariamente. Son las series temporales con los resultados de MoMo para ámbito nacional y de comunidades autónomas, en diferentes grupos poblacionales, durante los últimos dos años. Consta de las siguientes columnas:

ambito: nacional o ccaa
cod_ambito: si es nacional, viene vacío. Si es una comunidad autónoma, trae su código ISO 3166-2.
cod_ine_ambito: columna informativa sobre la comunidad autónoma, si aplica. Es su código INE.
nombre_ambito: columna informativa sobre la comunidad autónoma, si aplica. Es su nombre.
cod_sexo: código INE del sexo. 1 para hombres, 6 para mujeres.
nombre_sexo: columna informativa sobre el sexo. Su nombre descriptivo (hombres, mujeres).
cod_gedad: código del grupo de edad. Los posibles son: menos_65, 65_74, mas_74.
nombre_gedad: columna informativa sobre el grupo de edad. Su nombre descriptivo (p.e. edad < 65).
fecha_defuncion: la fecha a la que se refieren los indicadores descritos de aquí en adelante. Es la fecha en la que ocurre la defunción.
defunciones_observadas: el número de defunciones observadas (incluye la corrección por retraso).
defunciones_observadas_lim_inf: el límite inferior del invervalo de confianza de las defunciones observadas (debido a la corrección).
defunciones_observadas_lim_sup: de forma equivalente, el límite superior.
defunciones_esperadas: el número de defunciones esperadas, resultantes del modelo.
defunciones_esperadas_q01: el límite inferior del intervalo de confianza de las defunciones esperadas, correspondiente al percentil 1 de la distribución.
defunciones_esperadas_q99: de forma equivalente, el límite superior, al percentil 99.

Las series vienen agregadas por ámbito, código de ámbito, sexo, grupo de edad y fecha de defunción. Nótese que las series que son agregados del resto vienen en otra serie aparte. P.e., si se quiere elegir la serie de toda la población (nacional, todos los sexos, todas las edades), hay que filtrar por ambito=“nacional”, cod_sexo=“all” y cod_gedad=“all”.

Los datos aquí descargados se refieren a las defunciones por todas las causas notificadas por los registros civiles informatizados de los municipios correspondientes. Para saber más, consulta las pestañas de “Documentación” y “Notificación”.

Nota: los datos cambian de forma retroactiva, especialmente en los días más recientes. Lo que hoy puedes descargar (o consultar en este portal) mañana puede tener indicadores diferentes en fechas pasadas. El motivo es el retraso en la notificación, detallado en la sección de Documentación.

link_momo <- 'https://momo.isciii.es/public/momo/data'
# Los datos en local
data <- read_csv("data/data.csv", col_types = cols(cod_ambito = col_character(), 
    cod_ine_ambito = col_character(), nombre_ambito = col_character()), 
    locale = locale(date_names = "es", encoding = "ISO-8859-1"))
summary(data)
# Directamente de Internet
# momo_isciii <- read_csv(link_momo, locale = locale(date_names = "es"))
# momo_isciii <- read_delim(link_momo, ",", escape_double = FALSE, 
#                           # col_names = FALSE, 
#                           locale = locale(date_names = "es", 
#                                           decimal_mark = ",",      
#                                           grouping_mark = "."),
#                           trim_ws = TRUE)
momo_isciii <- read_csv(link_momo, col_types = cols(cod_ambito = col_character(), 
    cod_ine_ambito = col_character(), nombre_ambito = col_character()), 
    locale = locale(date_names = "es", encoding = "UTF-8"))

ETL

Pasamos algunos valores a factor

momo_isciii$ambito          <- as.factor(momo_isciii$ambito)
momo_isciii$cod_ambito      <- as.factor(momo_isciii$cod_ambito)
momo_isciii$cod_ine_ambito  <- as.factor(momo_isciii$cod_ine_ambito)
momo_isciii$nombre_ambito   <- as.factor(momo_isciii$nombre_ambito)
momo_isciii$cod_sexo        <- as.factor(momo_isciii$cod_sexo)
momo_isciii$nombre_sexo     <- as.factor(momo_isciii$nombre_sexo)
momo_isciii$cod_gedad       <- as.factor(momo_isciii$cod_gedad)
momo_isciii$nombre_gedad    <- as.factor(momo_isciii$nombre_gedad)
summary(momo_isciii)
##       ambito         cod_ambito     cod_ine_ambito  
##  ccaa    :170772   AN     :  8988   1      :  8988  
##  nacional:  8988   AR     :  8988   10     :  8988  
##                    AS     :  8988   11     :  8988  
##                    CB     :  8988   12     :  8988  
##                    CE     :  8988   13     :  8988  
##                    (Other):125832   (Other):125832  
##                    NA's   :  8988   NA's   :  8988  
##                  nombre_ambito    cod_sexo     nombre_sexo       cod_gedad    
##  Andalucía              :  8988   1  :59920   hombres:59920   65_74   :44940  
##  Aragón                 :  8988   6  :59920   mujeres:59920   all     :44940  
##  Asturias, Principado de:  8988   all:59920   todos  :59920   mas_74  :44940  
##  Balears, Illes         :  8988                               menos_65:44940  
##  Canarias               :  8988                                               
##  (Other)                :125832                                               
##  NA's                   :  8988                                               
##      nombre_gedad   fecha_defuncion      defunciones_observadas
##  edad < 65 :44940   Min.   :2018-05-11   Min.   :   0.00       
##  edad > 75 :44940   1st Qu.:2018-11-14   1st Qu.:   2.00       
##  edad 65-74:44940   Median :2019-05-20   Median :   8.00       
##  todos     :44940   Mean   :2019-05-20   Mean   :  37.39       
##                     3rd Qu.:2019-11-23   3rd Qu.:  27.00       
##                     Max.   :2020-05-28   Max.   :2962.00       
##                                                                
##  defunciones_observadas_lim_inf defunciones_observadas_lim_sup
##  Min.   :   0.00                Min.   :   0.00               
##  1st Qu.:   2.00                1st Qu.:   2.00               
##  Median :   8.00                Median :   8.00               
##  Mean   :  37.36                Mean   :  37.43               
##  3rd Qu.:  27.00                3rd Qu.:  27.00               
##  Max.   :2962.00                Max.   :2962.00               
##                                                               
##  defunciones_esperadas defunciones_esperadas_q01 defunciones_esperadas_q99
##  Min.   :   0.00       Min.   :   0.00           Min.   :   0.00          
##  1st Qu.:   2.00       1st Qu.:   0.00           1st Qu.:   6.24          
##  Median :   8.00       Median :   2.76           Median :  15.00          
##  Mean   :  36.26       Mean   :  27.52           Mean   :  47.75          
##  3rd Qu.:  26.50       3rd Qu.:  16.38           3rd Qu.:  38.93          
##  Max.   :1333.00       Max.   :1182.28           Max.   :1699.27          
## 

Esto lo necesitamos para “traducir” los códigos

table(momo_isciii$cod_ambito, momo_isciii$nombre_ambito)
##     
##      Andalucía Aragón Asturias, Principado de Balears, Illes Canarias Cantabria
##   AN      8988      0                       0              0        0         0
##   AR         0   8988                       0              0        0         0
##   AS         0      0                    8988              0        0         0
##   CB         0      0                       0              0        0      8988
##   CE         0      0                       0              0        0         0
##   CL         0      0                       0              0        0         0
##   CM         0      0                       0              0        0         0
##   CN         0      0                       0              0     8988         0
##   CT         0      0                       0              0        0         0
##   EX         0      0                       0              0        0         0
##   GA         0      0                       0              0        0         0
##   IB         0      0                       0           8988        0         0
##   MC         0      0                       0              0        0         0
##   MD         0      0                       0              0        0         0
##   ML         0      0                       0              0        0         0
##   NC         0      0                       0              0        0         0
##   PV         0      0                       0              0        0         0
##   RI         0      0                       0              0        0         0
##   VC         0      0                       0              0        0         0
##     
##      Castilla - La Mancha Castilla y León Cataluña Ceuta Comunitat Valenciana
##   AN                    0               0        0     0                    0
##   AR                    0               0        0     0                    0
##   AS                    0               0        0     0                    0
##   CB                    0               0        0     0                    0
##   CE                    0               0        0  8988                    0
##   CL                    0            8988        0     0                    0
##   CM                 8988               0        0     0                    0
##   CN                    0               0        0     0                    0
##   CT                    0               0     8988     0                    0
##   EX                    0               0        0     0                    0
##   GA                    0               0        0     0                    0
##   IB                    0               0        0     0                    0
##   MC                    0               0        0     0                    0
##   MD                    0               0        0     0                    0
##   ML                    0               0        0     0                    0
##   NC                    0               0        0     0                    0
##   PV                    0               0        0     0                    0
##   RI                    0               0        0     0                    0
##   VC                    0               0        0     0                 8988
##     
##      Extremadura Galicia Madrid, Comunidad de Melilla Murcia, Región de
##   AN           0       0                    0       0                 0
##   AR           0       0                    0       0                 0
##   AS           0       0                    0       0                 0
##   CB           0       0                    0       0                 0
##   CE           0       0                    0       0                 0
##   CL           0       0                    0       0                 0
##   CM           0       0                    0       0                 0
##   CN           0       0                    0       0                 0
##   CT           0       0                    0       0                 0
##   EX        8988       0                    0       0                 0
##   GA           0    8988                    0       0                 0
##   IB           0       0                    0       0                 0
##   MC           0       0                    0       0              8988
##   MD           0       0                 8988       0                 0
##   ML           0       0                    0    8988                 0
##   NC           0       0                    0       0                 0
##   PV           0       0                    0       0                 0
##   RI           0       0                    0       0                 0
##   VC           0       0                    0       0                 0
##     
##      Navarra, Comunidad Foral de País Vasco Rioja, La
##   AN                           0          0         0
##   AR                           0          0         0
##   AS                           0          0         0
##   CB                           0          0         0
##   CE                           0          0         0
##   CL                           0          0         0
##   CM                           0          0         0
##   CN                           0          0         0
##   CT                           0          0         0
##   EX                           0          0         0
##   GA                           0          0         0
##   IB                           0          0         0
##   MC                           0          0         0
##   MD                           0          0         0
##   ML                           0          0         0
##   NC                        8988          0         0
##   PV                           0       8988         0
##   RI                           0          0      8988
##   VC                           0          0         0

Guardamos

saveRDS(momo_isciii, file = paste0('./data/momo_isciii_', Sys.Date(),'.rds'))

Gráficos MoMo

p <- ggplot(momo_isciii, aes(x = log(price), color = clarity)) + 
    geom_freqpoly()
ggplotly(p)
# Un dataset intermedio
momo_temp <- momo_isciii %>% 
    dplyr::filter(ambito == 'nacional', cod_sexo == 'all', cod_gedad == 'all')


figura2 <- plot_ly(momo_temp, 
                   x = ~fecha_defuncion, y = ~defunciones_esperadas_q99, 
                   type = 'scatter', mode = 'lines',
                   line = list(color = 'transparent'),
                   showlegend = FALSE, name = 'Esperadas límite superior') 
figura2 <- figura2 %>% add_trace(y = ~defunciones_esperadas_q01, 
                                 type = 'scatter', mode = 'lines',                         
                                 fill = 'tonexty', fillcolor = 'rgba(0, 100, 80, 0.2)', 
                                 line = list(color = 'transparent'),                         
                                 showlegend = FALSE, name = 'Esperadas límite inferior') 
figura2 <- figura2 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_esperadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='rgb(0, 100, 80)'),                         
                                 name = 'Defunciones Esperadas') 
figura2 <- figura2 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_observadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='black'),                         
                                 name = 'Defunciones Observadas') 
figura2
## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.

Defunciones observadas (negro) y defunciones estimadas (verde), con el intervalo de confianza al 99% (banda verde). España.

Mortalidad por todas las causas. Comunidades Autónomas

y = ~get(input$Measure)

# Un dataset intermedio
momo_temp <- momo_isciii %>% 
    dplyr::filter(ambito == 'nacional', cod_sexo == 'all', cod_gedad == 'all', 
                  fecha_defuncion > '2019-12-31')


figura3 <- plot_ly(momo_temp, 
                   x = ~fecha_defuncion, y = ~defunciones_esperadas_q99, 
                   type = 'scatter', mode = 'lines',
                   line = list(color = 'transparent'),
                   showlegend = FALSE, name = 'Esperadas límite superior') 
figura3 <- figura3 %>% add_trace(y = ~defunciones_esperadas_q01, 
                                 type = 'scatter', mode = 'lines',                         
                                 fill = 'tonexty', fillcolor = 'rgba(0, 100, 80, 0.2)', 
                                 line = list(color = 'transparent'),                         
                                 showlegend = FALSE, name = 'Esperadas límite inferior') 
figura3 <- figura3 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_esperadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='rgb(0, 100, 80)'),                         
                                 name = 'Defunciones Esperadas') 
figura3 <- figura3 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_observadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='black'),                         
                                 name = 'Defunciones Observadas') 
figura3 <- figura3 %>% layout(title = "Mortalidad por todas las causas. España")
figura3
# Un dataset intermedio
momo_temp <- momo_isciii %>% 
    dplyr::filter(ambito == 'nacional', cod_sexo == 'all', cod_gedad == 'all', 
                  fecha_defuncion > '2019-12-31')

# Algunos valores para plotly
a_x <- list(
  title = "Fecha",
  # titlefont = f1,
  showticklabels = TRUE,
  tickangle = 90,
  # tickfont = f2,
  exponentformat = "E"
)

a_y <- list(
  title = "Defunciones",
  # titlefont = f1,
  showticklabels = TRUE,
  # tickangle = 45,
  # tickfont = f2,
  exponentformat = "E"
)

figura4 <- plot_ly(momo_temp, 
                   x = ~fecha_defuncion, y = ~defunciones_esperadas_q99, 
                   type = 'scatter', mode = 'lines',
                   line = list(color = 'transparent'),
                   showlegend = FALSE, name = 'Esperadas límite superior') 
figura4 <- figura4 %>% add_trace(y = ~defunciones_esperadas_q01, 
                                 type = 'scatter', mode = 'lines',                         
                                 fill = 'tonexty', fillcolor = 'rgba(0, 100, 80, 0.2)', 
                                 line = list(color = 'transparent'),                         
                                 showlegend = FALSE, name = 'Esperadas límite inferior') 
figura4 <- figura4 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_esperadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='rgb(0, 100, 80)'),                         
                                 name = 'Defunciones Esperadas') 
figura4 <- figura4 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_observadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='black'),                         
                                 name = 'Defunciones Observadas') 
figura4 <- figura4 %>% layout(title = "Mortalidad por todas las causas. España",
                              xaxis = a_x, 
                              yaxis = a_y)

figura4 <- figura4 %>% config(locale = 'es')

figura4
# Un dataset intermedio
momo_temp <- momo_isciii %>% 
    dplyr::filter(nombre_ambito == 'Rioja, La', cod_sexo == 'all', cod_gedad == 'all', 
                  fecha_defuncion > '2019-12-31')

# Algunos valores para plotly
a_x <- list(
  title = "Fecha",
  # titlefont = f1,
  showticklabels = TRUE,
  tickangle = 90,
  # tickfont = f2,
  exponentformat = "E"
)

a_y <- list(
  title = "Defunciones",
  # titlefont = f1,
  showticklabels = TRUE,
  # tickangle = 45,
  # tickfont = f2,
  exponentformat = "E"
)

figura5 <- plot_ly(momo_temp, 
                   x = ~fecha_defuncion, y = ~defunciones_esperadas_q99, 
                   type = 'scatter', mode = 'lines',
                   line = list(color = 'transparent'),
                   showlegend = FALSE, name = 'Esperadas límite superior') 
figura5 <- figura5 %>% add_trace(y = ~defunciones_esperadas_q01, 
                                 type = 'scatter', mode = 'lines',                         
                                 fill = 'tonexty', fillcolor = 'rgba(0, 100, 80, 0.2)', 
                                 line = list(color = 'transparent'),                         
                                 showlegend = FALSE, name = 'Esperadas límite inferior') 
figura5 <- figura5 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_esperadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='rgb(0, 100, 80)'),                         
                                 name = 'Defunciones Esperadas') 
figura5 <- figura5 %>% add_trace(x = ~fecha_defuncion, y = ~defunciones_observadas, 
                                 type = 'scatter', mode = 'lines',                         
                                 line = list(color='black'),                         
                                 name = 'Defunciones Observadas') 
figura5 <- figura5 %>% layout(title       = "Mortalidad por todas las causas. La Rioja",
                              xaxis = a_x, 
                              yaxis = a_y)

figura5 <- figura5 %>% config(locale = 'es')

figura5

Analisis

madrid <- serie_historica_acumulados_isciii[serie_historica_acumulados_isciii$CCAA == 'Madrid, Comunidad de', ]
rioja <- serie_historica_acumulados_isciii[serie_historica_acumulados_isciii$CCAA == 'Rioja, La', ]
summary(rioja)
##                       CCAA        FECHA                CASOS          PCR+     
##  Rioja, La              :91   Min.   :2020-02-20   Min.   : NA   Min.   :   0  
##  Andalucía              : 0   1st Qu.:2020-03-13   1st Qu.: NA   1st Qu.: 296  
##  Aragón                 : 0   Median :2020-04-05   Median : NA   Median :2719  
##  Asturias, Principado de: 0   Mean   :2020-04-05   Mean   :NaN   Mean   :2187  
##  Cantabria              : 0   3rd Qu.:2020-04-27   3rd Qu.: NA   3rd Qu.:3904  
##  Ceuta                  : 0   Max.   :2020-05-20   Max.   : NA   Max.   :4033  
##  (Other)                : 0                        NA's   :91                  
##     TestAc+     Hospitalizados        UCI          Fallecidos   
##  Min.   : 273   Min.   :  13.0   Min.   : 1.00   Min.   :  0.0  
##  1st Qu.: 799   1st Qu.: 487.2   1st Qu.:43.00   1st Qu.: 57.5  
##  Median :1290   Median :1194.5   Median :74.50   Median :240.0  
##  Mean   :1075   Mean   : 962.2   Mean   :62.08   Mean   :200.1  
##  3rd Qu.:1374   3rd Qu.:1446.8   3rd Qu.:88.00   3rd Qu.:334.8  
##  Max.   :1395   Max.   :1504.0   Max.   :91.00   Max.   :354.0  
##  NA's   :50     NA's   :19       NA's   :17      NA's   :17     
##  diario_hospitalizados   diario_uci    diario_fallecidos
##  Min.   : 0.0          Min.   :0.000   Min.   : 0.000   
##  1st Qu.: 6.0          1st Qu.:0.000   1st Qu.: 1.000   
##  Median :14.0          Median :0.000   Median : 4.000   
##  Mean   :21.0          Mean   :1.233   Mean   : 4.849   
##  3rd Qu.:32.5          3rd Qu.:2.000   3rd Qu.: 8.000   
##  Max.   :78.0          Max.   :9.000   Max.   :19.000   
##  NA's   :20            NA's   :18      NA's   :18
start_point_daily <-  c(1, 1)
start_point_daily 
## [1] 1 1
## [1] 1 1
rioja_ts_uci_daily <- 
  rioja %>%  
  select(UCI) %>%
  ts(start = start_point_daily, frequency = 365)
## Adding missing grouping variables: `CCAA`
ts_info(rioja_ts_uci_daily)
##  The rioja_ts_uci_daily series is a mts object with 2 variables and 91 observations
##  Frequency: 365 
##  Start time: 1 1 
##  End time: 1 91
# Tiene que haber al menos dos años
ts_decompose(rioja_ts_uci_daily, type = 'additive')
ts_acf(rioja_ts_uci_daily, lag.max = 365)
summary(rioja_ts_uci_daily)
##       CCAA         UCI       
##  Min.   :17   Min.   : 1.00  
##  1st Qu.:17   1st Qu.:43.00  
##  Median :17   Median :74.50  
##  Mean   :17   Mean   :62.08  
##  3rd Qu.:17   3rd Qu.:88.00  
##  Max.   :17   Max.   :91.00  
##               NA's   :17
rioja_ts <- ts(rioja, frequency = 365, start = as.Date('2020-02-20'))
summary(rioja_ts)
##       CCAA        FECHA           CASOS          PCR+         TestAc+    
##  Min.   :17   Min.   :18312   Min.   : NA   Min.   :   0   Min.   : 273  
##  1st Qu.:17   1st Qu.:18334   1st Qu.: NA   1st Qu.: 296   1st Qu.: 799  
##  Median :17   Median :18357   Median : NA   Median :2719   Median :1290  
##  Mean   :17   Mean   :18357   Mean   :NaN   Mean   :2187   Mean   :1075  
##  3rd Qu.:17   3rd Qu.:18380   3rd Qu.: NA   3rd Qu.:3904   3rd Qu.:1374  
##  Max.   :17   Max.   :18402   Max.   : NA   Max.   :4033   Max.   :1395  
##                               NA's   :91                   NA's   :50    
##  Hospitalizados        UCI          Fallecidos    diario_hospitalizados
##  Min.   :  13.0   Min.   : 1.00   Min.   :  0.0   Min.   : 0.0         
##  1st Qu.: 487.2   1st Qu.:43.00   1st Qu.: 57.5   1st Qu.: 6.0         
##  Median :1194.5   Median :74.50   Median :240.0   Median :14.0         
##  Mean   : 962.2   Mean   :62.08   Mean   :200.1   Mean   :21.0         
##  3rd Qu.:1446.8   3rd Qu.:88.00   3rd Qu.:334.8   3rd Qu.:32.5         
##  Max.   :1504.0   Max.   :91.00   Max.   :354.0   Max.   :78.0         
##  NA's   :19       NA's   :17      NA's   :17      NA's   :20           
##    diario_uci    diario_fallecidos
##  Min.   :0.000   Min.   : 0.000   
##  1st Qu.:0.000   1st Qu.: 1.000   
##  Median :0.000   Median : 4.000   
##  Mean   :1.233   Mean   : 4.849   
##  3rd Qu.:2.000   3rd Qu.: 8.000   
##  Max.   :9.000   Max.   :19.000   
##  NA's   :18      NA's   :18

Datos por países

Una copia descarada de Worldwide COVID-19 spread visualization with R. Vamos, copiar y pegar…

# normalization function
fun.normalize <- function(x) {
    return ((x - min(x)) / (max(x) - min(x)))
}
# download dataset
df <- read_csv(url('https://covid.ourworldindata.org/data/ecdc/full_data.csv'))
## Parsed with column specification:
## cols(
##   date = col_date(format = ""),
##   location = col_character(),
##   new_cases = col_double(),
##   new_deaths = col_double(),
##   total_cases = col_double(),
##   total_deaths = col_double()
## )
# preprocess data
df_prep <- df %>%
    filter(location != 'World') %>%
    
    group_by(location) %>%
    # remove earlier dates
    filter(date > as.Date('2020-01-15', format = '%Y-%m-%d')) %>%
    # remove coutries with less than 1000 total cases
    filter(max(total_cases) > 1000) %>%
    # replace negative values with the mean 
    mutate(new_cases = ifelse(new_cases < 0,
                              round((lag(new_cases, default = 0) + lead(new_cases, default = 0)) / 2),
                              new_cases)) %>%
    ungroup() %>%
    select(location, date, new_cases) %>%
    # prepare data for normalization
    dcast(., date ~ location, value.var = 'new_cases') %>%
    # replace NAs with 0
    dmap_at(c(2:ncol(.)), function(x) ifelse(is.na(x), 0, x)) %>%
    # normalization
    dmap_at(c(2:ncol(.)), function(x) fun.normalize(x)) %>%
    melt(., id.vars = c('date'), variable.name = 'country') %>%
    mutate(value = round(value, 6))
# define countries order for plots
country_ord_1 <- df_prep %>%
    group_by(country) %>%
    filter(value == 1) %>%
    ungroup() %>%
    arrange(date, country) %>%
    distinct(country) %>%
    mutate(is_odd = ifelse((row_number() - 1) %% 2 == 0, TRUE, FALSE))

country_ord_anim <- bind_rows(country_ord_1 %>%
                                  filter(is_odd == TRUE) %>%
                                  arrange(desc(row_number())),
                              country_ord_1 %>%
                                  filter(is_odd == FALSE))
# data for animated plot
df_plot_anim <- df_prep %>%
    mutate(country = factor(country, levels = c(as.character(country_ord_anim$country)))) %>%
    group_by(country) %>%
    mutate(first_date = min(date[value >= 0.03])) %>%
    mutate(cust_label = ifelse(date >= first_date, as.character(country), '')) %>%
    ungroup()
# Animated Heatmap plot
p <- ggplot(df_plot_anim, aes(y = country, x = date, fill = value)) +
    theme_minimal() +
    geom_tile(color = 'white', width = .9, height = .9) +
    scale_fill_gradientn(colours = cols, limits = c(0, 1),
                         breaks = c(0, 1),
                         labels = c('0', 'max'),
                         guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
    
    geom_text(aes(x = first_date, label = cust_label), size = 3, color = '#797D7F') +
    scale_y_discrete(position = 'right') +
    coord_equal() +
    
    theme(legend.position = 'bottom',
          legend.direction = 'horizontal',
          plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
          axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
          axis.text.y = element_blank(),
          axis.title.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
    ) +
    ggtitle('The spread of COVID-19 across countries: new daily cases normalized to location maximum')
# Heatmap plot 1
df_plot_1 <- df_prep %>%
    mutate(country = factor(country, levels = c(as.character(country_ord_1$country)))) %>%
    group_by(country) %>%
    mutate(first_date = min(date[value >= 0.03])) %>%
    ungroup()

ggplot(df_plot_1, aes(y = country, x = date, fill = value)) +
    theme_minimal() +
    geom_tile(color = 'white', width = .9, height = .9) +
    scale_fill_gradientn(colours = cols, limits = c(0, 1),
                         breaks = c(0, 1),
                         labels = c('0', 'max'),
                         guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
    
    geom_text(aes(x = first_date, label = country), size = 3, color = '#797D7F') +
    scale_y_discrete(position = 'right') +
    coord_equal() +
    
    theme(legend.position = 'bottom',
          legend.direction = 'horizontal',
          plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
          axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
          axis.text.y = element_text(size = 6, hjust = .5, vjust = .5, face = 'plain'),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
    ) +
    ggtitle('The spread of COVID-19 across countries: new daily cases normalized to location maximum')
# Heatmap plot 2
df_plot_2 <- df_prep %>%
    group_by(country) %>%
    filter(date >= min(date[value > 0])) %>%
    arrange(date, .by_group = TRUE) %>%
    mutate(centr_day = min(row_number()[value == 1]),
           n_day = row_number() - centr_day) %>%
    ungroup()

country_ord_2 <- df_plot_2 %>%
    group_by(country) %>%
    filter(date >= min(date[value == 1])) %>%
    summarise(value = sum(value)) %>%
    ungroup() %>%
    arrange(value, country) %>%
    distinct(country)

df_plot_2 <- df_plot_2 %>%
    mutate(country = factor(country, levels = c(as.character(country_ord_2$country)))) %>%
    group_by(country) %>%
    mutate(first_date = min(n_day[value >= 0.01])) %>%
    ungroup()



# Heatmap plot 2
ggplot(df_plot_2, aes(y = country, x = n_day, fill = value)) +
    theme_minimal() +
    geom_tile(color = 'white', width = .9, height = .9) +
    scale_fill_gradientn(colours = cols, limits = c(0, 1),
                         breaks = c(0, 1),
                         labels = c('0', 'max'),
                         guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
    
    geom_text(aes(x = first_date, label = country), size = 3, color = '#797D7F') +
    coord_equal() +
    
    theme(legend.position = 'bottom',
          legend.direction = 'horizontal',
          plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
          axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
          #axis.text.y = element_text(size = 6, hjust = .5, vjust = .5, face = 'plain'),
          axis.text.y = element_blank(),
          axis.title.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
    ) +
    ggtitle('Comparison of different countries effectiveness against COVID-19 
                (new daily cases normalized to location maximum and data centered on a day with maximum new cases)')

… Así que alguien con poca imaginación y datos parecidos, sólo tiene que cambiar un poco el código

serie_isciii_tuneada <- serie_historica_acumulados_isciii %>%
    # filter(CCAA != 'World') %>%
    
    group_by(CCAA) %>%
    
    # remove earlier dates
    # filter(FECHA > as.Date('2020-01-15', format = '%Y-%m-%d')) %>%
    # remove coutries with less than 1000 total cases
    # filter(max(CASOS) > 1000) %>%
    # replace negative values with the mean 
    mutate(casos_nuevos = `PCR+` - lag(`PCR+`, default = 0)) %>%
    ungroup()
# preprocess data
serie_isciii_tuneada <- serie_historica_acumulados_isciii %>%
    # filter(CCAA != 'World') %>%
    
    group_by(CCAA) %>%
    
    # remove earlier dates
    # filter(FECHA > as.Date('2020-01-15', format = '%Y-%m-%d')) %>%
    # remove coutries with less than 1000 total cases
    # filter(max(CASOS) > 1000) %>%
    # replace negative values with the mean 
    # mutate(casos_nuevos = ifelse(casos_nuevos < 0,
    #                           round((lag(casos_nuevos, default = 0) + lead(casos_nuevos, default = 0)) / 2),
    #                           casos_nuevos)) %>%
    # ungroup() %>%
    select(CCAA, FECHA, casos_nuevos) %>%
    # prepare data for normalization
    dcast(., FECHA ~ CCAA, value.var = 'casos_nuevos') %>%
    # replace NAs with 0
    dmap_at(c(2:ncol(.)), function(x) ifelse(is.na(x), 0, x)) %>%
    # normalization
    dmap_at(c(2:ncol(.)), function(x) fun.normalize(x)) %>%
    melt(., id.vars = c('FECHA'), variable.name = 'CCAA') %>%
    mutate(value = round(value, 6))
# define countries order for plots
CCAA_ord_1 <- serie_isciii_tuneada %>%
    group_by(CCAA) %>%
    # filter(value == 1) %>%
    ungroup() %>%
    arrange(FECHA, CCAA) %>%
    distinct(CCAA) %>%
    mutate(is_odd = ifelse((row_number() - 1) %% 2 == 0, TRUE, FALSE))

CCAA_ord_anim <- bind_rows(CCAA_ord_1 %>%
                                  filter(is_odd == TRUE) %>%
                                  arrange(desc(row_number())),
                              CCAA_ord_1 %>%
                                  filter(is_odd == FALSE))
# data for animated plot
df_plot_anim <- serie_isciii_tuneada %>%
    mutate(CCAA = factor(CCAA, levels = c(as.character(CCAA_ord_anim$CCAA)))) %>%
    group_by(CCAA) %>%
    mutate(first_FECHA = min(FECHA[value >= 0.03])) %>%
    mutate(cust_label = ifelse(FECHA >= first_FECHA, as.character(CCAA), '')) %>%
    ungroup()
# Animated Heatmap plot
p <- ggplot(df_plot_anim, aes(y = CCAA, x = FECHA, fill = value)) +
    theme_minimal() +
    geom_tile(color = 'white', width = .9, height = .9) +
    scale_fill_gradientn(colours = cols, limits = c(0, 1),
                         breaks = c(0, 1),
                         labels = c('0', 'max'),
                         guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
    
    geom_text(aes(x = first_FECHA, label = cust_label), size = 3, color = '#797D7F') +
    scale_y_discrete(position = 'right') +
    coord_equal() +
    
    theme(legend.position = 'bottom',
          legend.direction = 'horizontal',
          plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
          axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
          axis.text.y = element_blank(),
          axis.title.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
    ) +
    ggtitle('The spread of COVID-19 across countries: new daily cases normalized to CCAA maximum')


anim <- p + 
    transition_components(FECHA) +
    ggtitle('The spread of COVID-19 across countries: new daily cases normalized to CCAA maximum',
            subtitle = 'FECHA {frame_time}') +
    shadow_mark()

animate(anim,
        nframes = as.numeric(difftime(max(df_plot_anim$FECHA), min(df_plot_anim$FECHA), units = 'days')) + 1,
        duration = 12,
        fps = 12,
        width = 1000,
        height = 840,
        start_pause = 5,
        end_pause = 25,
        renderer = gifski_renderer())
anim_save('covid19_CCAA.gif')
# Heatmap plot 1
df_plot_1 <- serie_isciii_tuneada %>%
    mutate(CCAA = factor(CCAA, levels = c(as.character(CCAA_ord_1$CCAA)))) %>%
    group_by(CCAA) %>%
    mutate(first_FECHA = min(FECHA[value >= 0.03])) %>%
    ungroup()

ggplot(df_plot_1, aes(y = CCAA, x = FECHA, fill = value)) +
    theme_minimal() +
    geom_tile(color = 'white', width = .9, height = .9) +
    scale_fill_gradientn(colours = cols, limits = c(0, 1),
                         breaks = c(0, 1),
                         labels = c('0', 'max'),
                         guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
    
    geom_text(aes(x = first_FECHA, label = CCAA), size = 3, color = '#797D7F') +
    scale_y_discrete(position = 'right') +
    coord_equal() +
    
    theme(legend.position = 'bottom',
          legend.direction = 'horizontal',
          plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
          axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
          axis.text.y = element_text(size = 6, hjust = .5, vjust = .5, face = 'plain'),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
    ) +
    ggtitle('The spread of COVID-19 across countries: new daily cases normalized to CCAA maximum')
# Heatmap plot 2
df_plot_2 <- serie_isciii_tuneada %>%
    group_by(CCAA) %>%
    filter(FECHA >= min(FECHA[value > 0])) %>%
    arrange(FECHA, .by_group = TRUE) %>%
    mutate(centr_day = min(row_number()[value == 1]),
           n_day = row_number() - centr_day) %>%
    ungroup()

CCAA_ord_2 <- df_plot_2 %>%
    group_by(CCAA) %>%
    filter(FECHA >= min(FECHA[value == 1])) %>%
    summarise(value = sum(value)) %>%
    ungroup() %>%
    arrange(value, CCAA) %>%
    distinct(CCAA)

df_plot_2 <- df_plot_2 %>%
    mutate(CCAA = factor(CCAA, levels = c(as.character(CCAA_ord_2$CCAA)))) %>%
    group_by(CCAA) %>%
    mutate(first_FECHA = min(n_day[value >= 0.01])) %>%
    ungroup()



# Heatmap plot 2
ggplot(df_plot_2, aes(y = CCAA, x = n_day, fill = value)) +
    theme_minimal() +
    geom_tile(color = 'white', width = .9, height = .9) +
    scale_fill_gradientn(colours = cols, limits = c(0, 1),
                         breaks = c(0, 1),
                         labels = c('0', 'max'),
                         guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
    
    geom_text(aes(x = first_FECHA, label = CCAA), size = 3, color = '#797D7F') +
    coord_equal() +
    
    theme(legend.position = 'bottom',
          legend.direction = 'horizontal',
          plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
          axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
          #axis.text.y = element_text(size = 6, hjust = .5, vjust = .5, face = 'plain'),
          axis.text.y = element_blank(),
          axis.title.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
    ) +
    ggtitle('Comparison of different countries effectiveness against COVID-19 
                (new daily cases normalized to CCAA maximum and data centered on a day with maximum new cases)')

Terminamos con la información de la sesión

sessionInfo()
## R version 4.0.0 (2020-04-24)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 18.04.4 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1
## 
## locale:
##  [1] LC_CTYPE=es_ES.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=es_ES.UTF-8        LC_COLLATE=es_ES.UTF-8    
##  [5] LC_MONETARY=es_ES.UTF-8    LC_MESSAGES=es_ES.UTF-8   
##  [7] LC_PAPER=es_ES.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=es_ES.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] sf_0.9-3        gifski_0.8.6    gganimate_1.0.5 purrrlyr_0.0.6 
##  [5] reshape2_1.4.4  forcats_0.5.0   purrr_0.3.4     tidyr_1.1.0    
##  [9] tibble_3.0.1    tidyverse_1.3.0 plotly_4.9.2.1  ggplot2_3.3.1  
## [13] stringr_1.4.0   tmap_3.0        rvest_0.3.5     xml2_1.3.2     
## [17] TSstudio_0.1.6  dplyr_1.0.0     readr_1.3.1    
## 
## loaded via a namespace (and not attached):
##  [1] nlme_3.1-147            fs_1.4.1                xts_0.12-0             
##  [4] lubridate_1.7.8         progress_1.2.2          RColorBrewer_1.1-2     
##  [7] httr_1.4.1              tools_4.0.0             backports_1.1.7        
## [10] R6_2.4.1                KernSmooth_2.23-17      DBI_1.1.0              
## [13] lazyeval_0.2.2          colorspace_1.4-1        raster_3.1-5           
## [16] withr_2.2.0             sp_1.4-2                prettyunits_1.1.1      
## [19] tidyselect_1.1.0        leaflet_2.0.3           curl_4.3               
## [22] compiler_4.0.0          leafem_0.1.1            cli_2.0.2              
## [25] labeling_0.3            scales_1.1.1            classInt_0.4-3         
## [28] digest_0.6.25           rmarkdown_2.1           base64enc_0.1-3        
## [31] dichromat_2.0-0         pkgconfig_2.0.3         htmltools_0.4.0        
## [34] dbplyr_1.4.4            htmlwidgets_1.5.1       rlang_0.4.6            
## [37] readxl_1.3.1            rstudioapi_0.11         farver_2.0.3           
## [40] generics_0.0.2          zoo_1.8-8               jsonlite_1.6.1         
## [43] crosstalk_1.1.0.1       magrittr_1.5            Rcpp_1.0.4.6           
## [46] munsell_0.5.0           fansi_0.4.1             abind_1.4-5            
## [49] lifecycle_0.2.0         stringi_1.4.6           leafsync_0.1.0         
## [52] yaml_2.2.1              tmaptools_3.0           plyr_1.8.6             
## [55] grid_4.0.0              blob_1.2.1              parallel_4.0.0         
## [58] crayon_1.3.4            lattice_0.20-41         stars_0.4-1            
## [61] haven_2.3.0             hms_0.5.3               knitr_1.28             
## [64] pillar_1.4.4            codetools_0.2-16        reprex_0.3.0           
## [67] XML_3.99-0.3            glue_1.4.1              evaluate_0.14          
## [70] leaflet.providers_1.9.0 data.table_1.12.8       modelr_0.1.8           
## [73] selectr_0.4-2           tweenr_1.0.1            png_0.1-7              
## [76] vctrs_0.3.0             cellranger_1.1.0        gtable_0.3.0           
## [79] assertthat_0.2.1        xfun_0.14               lwgeom_0.2-4           
## [82] broom_0.5.6             e1071_1.7-3             class_7.3-17           
## [85] viridisLite_0.3.0       units_0.6-6             ellipsis_0.3.1

Licencias

 

A work by Santiago Mota

santiago_mota@yahoo.es